[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-env (setp 2 [plist :c]))

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

(with-env (setp 2 [plist :c]))

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-type-map compiler-macro cl:compiler-macro)

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

(define-simple-type-map compiler-macro cl:compiler-macro)

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

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


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

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

(with-generator 'some-name)

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

;; macroexpand:
(let ((quote some-name))
  (assert (typep quote 'generator!))
  (unwind-protect (progn) (stop quote)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun/1 atan2 (x y) (atan x y))

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

(defun/1 atan2 (x y) (atan x y))

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(signal-reader-error "No character for char-code #x~X" code)

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

(signal-reader-error "No character for char-code #x~X" code)

[Assistant]
(defmacro signal-reader-error (format-control &rest format-arguments)
  "Like ERROR but signals a SIMPLE-READER-ERROR for the stream
*STREAM*."
  `(error 'simple-reader-error
          :stream *stream*
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

;; macroexpand:
(error (quote simple-reader-error) :stream *stream* :format-control "No character for char-code #x~X" :format-arguments (list code))


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

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

(expand-selector selector)

[Assistant]
(defmacro expand-selector (&rest args)
  `(let ((result ,@args))
     (cond ((typep result 'kv-container) result)
	   ((typep result 'pair)         result)
	   ((null result)                result)
	   (t ($+ result)))))

;; macroexpand:
(let ((result selector)) (cond ((typep result (quote kv-container)) result) ((typep result (quote pair)) result) ((null result) result) (t ($+ result))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-simple-definition-resolver method-combination (designator) (find-method #'sb-mop:find-method-combination nil (list (find-class 'cl:generic-function) `(eql ,designator) T) nil))

Write a macro that addresses: Macro call that should be transformed by define-simple-definition-resolver

(define-simple-definition-resolver method-combination (designator) (find-method #'sb-mop:find-method-combination nil (list (find-class 'cl:generic-function) `(eql ,designator) T) nil))

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

;; macroexpand:
(define-definition-resolver method-combination (method-combination #:package143) (when (ignore-errors (let ((designator method-combination)) (find-method (common-lisp:function sb-mop:find-method-combination) nil (list (find-class (quote common-lisp:generic-function)) (sb-int:quasiquote (eql #S(sb-impl::comma :expr designator :kind 0))) t) nil))) (list (make-instance (quote method-combination) :designator method-combination :package #:package143))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-simple-definition-resolver vop (designator) (sb-c::vop-parse-or-lose designator))

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

(define-simple-definition-resolver vop (designator) (sb-c::vop-parse-or-lose designator))

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

;; macroexpand:
(define-definition-resolver vop (vop #:package150) (when (ignore-errors (let ((designator vop)) (sb-c::vop-parse-or-lose designator))) (list (make-instance (quote vop) :designator vop :package #:package150))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-custom-var (:array-element *array-element-handler*))

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

(define-custom-var (:array-element *array-element-handler*))

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

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


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

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

(with-symbol-access
  nil)

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

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


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

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

($)

[Assistant]
(defmacro $ ...)

;; macroexpand:
nil


[User]
You are a Common Lisp macro expert. Given this code pattern:
(set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'init-accumulator :array-member #'accumulator-add :end-of-array #'accumulator-get-sequence :array-type 'vector :beginning-of-object #'init-accumulator-and-prototype :object-key #'accumulator-add-key-or-set-prototype :object-value #'accumulator-add-value-or-set-prototype :end-of-object #'accumulator-get-object :beginning-of-string #'init-string-stream-accumulator :string-char #'string-stream-accumulator-add :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :object-scope (union *object-scope-variables* '(*prototype* *json-array-type*)) :internal-decoder #'decode-json)

Write a macro that addresses: Macro call that should be transformed by set-custom-vars

(set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'init-accumulator :array-member #'accumulator-add :end-of-array #'accumulator-get-sequence :array-type 'vector :beginning-of-object #'init-accumulator-and-prototype :object-key #'accumulator-add-key-or-set-prototype :object-value #'accumulator-add-value-or-set-prototype :end-of-object #'accumulator-get-object :beginning-of-string #'init-string-stream-accumulator :string-char #'string-stream-accumulator-add :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :object-scope (union *object-scope-variables* '(*prototype* *json-array-type*)) :internal-decoder #'decode-json)

[Assistant]
(defmacro set-custom-vars (&rest key-args)
  `(setq
    ,@(loop for (supplied-key value) on key-args by #'cddr
         append (loop for (var . var-key) in *custom-vars*
                   thereis (if (eql var-key supplied-key)
                               (list var value))))))

;; macroexpand:
(setq *integer-handler* (function parse-number) *real-handler* (function parse-number) *boolean-handler* (function json-boolean-to-lisp) *beginning-of-array-handler* (function init-accumulator) *array-member-handler* (function accumulator-add) *end-of-array-handler* (function accumulator-get-sequence) *json-array-type* (quote vector) *beginning-of-object-handler* (function init-accumulator-and-prototype) *object-key-handler* (function accumulator-add-key-or-set-prototype) *object-value-handler* (function accumulator-add-value-or-set-prototype) *end-of-object-handler* (function accumulator-get-object) *beginning-of-string-handler* (function init-string-stream-accumulator) *string-char-handler* (function string-stream-accumulator-add) *end-of-string-handler* (function string-stream-accumulator-get) *aggregate-scope-variables* (union *aggregate-scope-variables* (quote (*accumulator* *accumulator-last*))) *object-scope-variables* (union *object-scope-variables* (quote (*prototype* *json-array-type*))) *internal-decoder* (function decode-json))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(unroll-assignment-ops += -= *= /= %= <<= >>= &= ^= |\|=|)

Write a macro that addresses: Macro call that should be transformed by unroll-assignment-ops

(unroll-assignment-ops += -= *= /= %= <<= >>= &= ^= |\|=|)

[Assistant]
(defmacro unroll-assignment-ops (&rest ops)
  `(progn
     ,@(loop for op in ops collect
            `(defmacro ,(find-symbol (symbol-name op) '#:vacietis.c)
                 (lvalue rvalue)
               `(setf ,lvalue
                      (,',(find-symbol
                           (reverse (subseq (reverse (symbol-name op)) 1))
                           '#:vacietis.c)
                          ,lvalue
                          ,rvalue))))))

;; macroexpand:
(progn (defmacro vacietis.c:+= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:+) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:-= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:-) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:*= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:*) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:/= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:/) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:%= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:%) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:<<= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:<<) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:>>= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:>>) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:&= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:&) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:^= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:^) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:|\|=| (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:|\||) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(check-cursor-attached cluffer:item-after-cursor (cursor))

Problem: Macro call that should be transformed by check-cursor-attached

(check-cursor-attached cluffer:item-after-cursor (cursor))

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

;; macroexpand:
(defmethod cluffer:item-after-cursor :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-clause always (form &aux (result T)) (values `(unless ,form (setf ,result NIL) (end-for)) result))

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

(define-simple-clause always (form &aux (result T)) (values `(unless ,form (setf ,result NIL) (end-for)) result))

[Assistant]
(defmacro define-simple-clause (name args &body body)
  (multiple-value-bind (args outer-let inner-let result-let) (compute-binding-parts NIL NIL args)
    `(define-direct-clause ,name ,(rest args)
       (let ,outer-let
         (values* `(let* ,(list
                           ,@result-let)
                     (declare (ignorable ,,@(mapcar #'delist outer-let))))
                  (let ,inner-let
                    (declare (ignorable ,@(mapcar #'delist inner-let)))
                    ,@body))))))

;; macroexpand:
(define-direct-clause always (form) (let ((#:result185 (gensym #A((6) base-char . "RESULT")))) (values* (sb-int:quasiquote (let* #S(sb-impl::comma :expr (list (list #:result185 (quote t))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:result185 :kind 0))))) (let ((result #:result185)) (declare (ignorable result)) (values (sb-int:quasiquote (unless #S(sb-impl::comma :expr form :kind 0) (setf #S(sb-impl::comma :expr result :kind 0) nil) (end-for))) result)))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-unique-js-names)

Issue: Macro call that should be transformed by WITH-UNIQUE-JS-NAMES

(with-unique-js-names)

[Assistant]
(defmacro WITH-UNIQUE-JS-NAMES ...)

;; macroexpand:
(with-ps-gensyms)


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

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

(with-collectors nil)

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

;; macroexpand:
(progn)


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

Problem: Macro call that should be transformed by THE-PART

(the-part 'some-name)

[Assistant]
(defmacro THE-PART ...)

;; macroexpand:
(send part 'some-name)


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

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

(letmatch nil
    (progn))

[Assistant]
(defmacro LETMATCH ...)

;; macroexpand:
(ifmatch (nil (progn) nil (error "LETMATCH:  mismatch.")))


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

Problem: Macro call that should be transformed by DEFACTION

(defaction nil
    nil)

[Assistant]
(defmacro DEFACTION ...)

;; macroexpand:
(setf (gethash #A((3) base-char . "NIL") cl-rules.core::*actions*) (lambda ()))


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

Problem: Macro call that should be transformed by JS-INLINE

(js-inline nil (progn))

[Assistant]
(defmacro JS-INLINE ...)

;; macroexpand:
(js-inline* '(progn nil (progn)))


[User]
Generate a defmacro form that transforms code like this:
(with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))

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

(with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))

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

;; macroexpand:
(if *enable-colors* (if (or (eq :yellow :gray) (eq :yellow :grey) (eq :yellow +gray+) (eq :yellow +grey+)) (with-gray stream (format/indent reporter stream "△ Tests were run but no plan was declared.~%")) (cl-ansi-text:with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))) (progn (format/indent reporter stream "△ Tests were run but no plan was declared.~%")))


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

Problem: Macro call that should be transformed by DEFPATTERN

(defpattern nil
    nil)

[Assistant]
(defmacro DEFPATTERN ...)

;; macroexpand:
(eval-always
  (setf (get 'nil 'cl-match-pattern)
          (lambda (#:g133)
            (lett nil
                #:g133))))


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

What needs to change: Macro call that should be transformed by LTBDD-WITH-NEW-HASH

(ltbdd-with-new-hash nil)

[Assistant]
(defmacro LTBDD-WITH-NEW-HASH ...)

;; macroexpand:
(bdd-call-with-new-hash (lambda ()) :bdd-node-type
                        '(or lisp-type-bdd-node bdd-leaf))


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

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

(->>
  nil
  nil)

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

;; macroexpand:
(let* ((#:var183 nil) (#:var184 (nil #:var183)))
  #:var184)


[User]
Generate a defmacro form that transforms code like this:
(define-path-instruction-pair smooth-curve-to "S" (control-x2 control-y2 x y))

Pattern to recognize: Macro call that should be transformed by define-path-instruction-pair

(define-path-instruction-pair smooth-curve-to "S" (control-x2 control-y2 x y))

[Assistant]
(defmacro define-path-instruction-pair (name instruction (&rest args))
  (let ((draw-relative (intern (concatenate 'string (string name) "-R"))))
    `(progn
       (defun ,name (,@args)
         (format-instruction ,instruction ,@args))
       (defun ,draw-relative (,@args)
         (format-instruction ,(string-downcase instruction) ,@args)))))

;; macroexpand:
(progn (defun smooth-curve-to (control-x2 control-y2 x y) (format-instruction "S" control-x2 control-y2 x y)) (defun smooth-curve-to-r (control-x2 control-y2 x y) (format-instruction "s" control-x2 control-y2 x y)))


[User]
Generate a defmacro form that transforms code like this:
(with-html-string (:p :dataset (:duck (dolomphious) :fish 'fizzgigious :spoon "runcible")))

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

(with-html-string (:p :dataset (:duck (dolomphious) :fish 'fizzgigious :spoon "runcible")))

[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 (:p :dataset (:duck (dolomphious) :fish (quote fizzgigious) :spoon "runcible"))))


[User]
Write a Common Lisp macro to handle this code pattern:
(lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

Problem: Macro call that should be transformed by lret*

(lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

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

;; macroexpand:
(lret-aux let* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))


[User]
Generate a defmacro form that transforms code like this:
(augment post-code `((setq ,extra-save-var ,var)))

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

(augment post-code `((setq ,extra-save-var ,var)))

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

;; macroexpand:
(setf post-code (nconc post-code (sb-int:quasiquote ((setq #S(sb-impl::comma :expr extra-save-var :kind 0) #S(sb-impl::comma :expr var :kind 0))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(*> +period+ +any-digit+ +digits+)

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

(*> +period+ +any-digit+ +digits+)

[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 (#:*>-offset184) (multiple-value-bind (#:*>-res187 #:*>-next188) (multiple-value-bind (#:*>-res185 #:*>-next186) (funcall +period+ #:*>-offset184) (if (ok? #:*>-res185) (funcall +any-digit+ #:*>-next186) (fail #:*>-next186))) (if (ok? #:*>-res187) (funcall +digits+ #:*>-next188) (fail #:*>-next188))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-env [assoc-list 'c])

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

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

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-test partially-correct (true "Happy") (is = (get-universal-time) 2962566000))

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

(define-test partially-correct (true "Happy") (is = (get-universal-time) 2962566000))

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

;; macroexpand:
(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote partially-correct) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote partially-correct) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (true "Happy")) (lambda nil (is = (get-universal-time) 2962566000))) :parent (quote nil))) (quote partially-correct))


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

Problem: Macro call that should be transformed by is

(is (< 0 1))

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

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

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(%destructure-defhook-args args (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) `(progn (%defhook-fun ,hook-name ,vanilla-lambda-list ,@body) (%define-method-dispatch ,generic-function ,qualifier ,specialized-lambda-list)))))

What needs to change: Macro call that should be transformed by %destructure-defhook-args

(%destructure-defhook-args args (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) `(progn (%defhook-fun ,hook-name ,vanilla-lambda-list ,@body) (%define-method-dispatch ,generic-function ,qualifier ,specialized-lambda-list)))))

[Assistant]
(defmacro %destructure-defhook-args (args &body body)
  (let ((args-sym (gensym)))
    `(let* ((,args-sym ,args)
            (qualifier
            (cond ((and (symbolp (car ,args-sym)) (not (null (car ,args-sym))))
                   (prog1 (car ,args-sym) (setf ,args-sym (cdr ,args-sym))))
                  (t :use-default))))
       (destructuring-bind (specialized-lambda-list &body body) ,args-sym
         ,@body))))

;; macroexpand:
(let* ((#:g122 args) (qualifier (cond ((and (symbolp (car #:g122)) (not (null (car #:g122)))) (prog1 (car #:g122) (setf #:g122 (cdr #:g122)))) (t :use-default)))) (destructuring-bind (specialized-lambda-list &body body) #:g122 (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) (sb-int:quasiquote (progn (%defhook-fun #S(sb-impl::comma :expr hook-name :kind 0) #S(sb-impl::comma :expr vanilla-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)) (%define-method-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr specialized-lambda-list :kind 0))))))))


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

Problem: Macro call that should be transformed by DEFINE-TEMPLATE

(define-template nil :key nil)

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

;; macroexpand:
(defmacro define-nil (:key &optional (#:name128))
  (flet ((template-unfulfillable ()
           (error 'template-unfulfillable :template 'nil :arguments
                  (list :key))))
    (declare (ignorable (function template-unfulfillable)))
    (let ((body (progn)) (name (or #:name128 (compose-name #\SOLIDUS 'nil))))
      `(progn
        (declaim
         (ftype
          (function
           ,(loop with types = (declared-variable-types body)
                  for arg in (quote nil)
                  collect (or (second (assoc arg types)) (quote t)))
           ,(declared-return-type body))
          ,name)
         ,@(when (find (quote inline) (declarations body)) `((inline ,name))))
        (defun ,name ,'nil
          (declare (optimize speed (safety 0) (debug 0) (compilation-speed 0))
                   ,@(remove (quote inline) (declarations body)))
          ,@(remove-if #'declaration-p body))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-fixture-restore function (symbol value) (setf (fdefinition symbol) value))

Problem: Macro call that should be transformed by define-fixture-restore

(define-fixture-restore function (symbol value) (setf (fdefinition symbol) value))

[Assistant]
(defmacro define-fixture-restore (name args &body body)
  `(progn (setf (gethash ',name *fixture-restores*)
                (lambda ,args ,@body))
          ',name))

;; macroexpand:
(progn (setf (gethash (quote function) *fixture-restores*) (lambda (symbol value) (setf (fdefinition symbol) value))) (quote function))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-hook (:boot foreign-libraries (- most-positive-fixnum 10)) () (status 0 "Reloading foreign libraries.") (flet ((maybe-load (lib) (let ((lib (ensure-library lib)) #+sbcl(sb-ext:*muffled-warnings* 'style-warning)) (unless (or (library-open-p lib) (library-dont-open-p lib)) (status 1 "Loading foreign library ~a." lib) (open-library lib))))) (dolist (lib *foreign-libraries-to-reload*) (maybe-load lib))))

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

(define-hook (:boot foreign-libraries (- most-positive-fixnum 10)) () (status 0 "Reloading foreign libraries.") (flet ((maybe-load (lib) (let ((lib (ensure-library lib)) #+sbcl(sb-ext:*muffled-warnings* 'style-warning)) (unless (or (library-open-p lib) (library-dont-open-p lib)) (status 1 "Loading foreign library ~a." lib) (open-library lib))))) (dolist (lib *foreign-libraries-to-reload*) (maybe-load lib))))

[Assistant]
(defmacro define-hook ((type name &optional (priority 0)) args &body body)
  (ecase type (:pre-load) (:load) (:build) (:deploy) (:boot) (:quit))
  (check-type name symbol)
  `(let ((,name (or (hook ,type ',name)
                    (make-instance 'hook :name ',name :type ,type))))
     (setf (hook-priority ,name) ,priority)
     (setf (hook-function ,name) (flet ((,name (&key ,@args &allow-other-keys)
                                          ,@body))
                                   #',name))
     (setf (hook ,type ',name) ,name)
     (setf (docstring ,name) ,(if (stringp (car body)) (car body)))
     ',name))

;; macroexpand:
(let ((foreign-libraries (or (hook :boot (quote foreign-libraries)) (make-instance (quote hook) :name (quote foreign-libraries) :type :boot)))) (setf (hook-priority foreign-libraries) (- most-positive-fixnum 10)) (setf (hook-function foreign-libraries) (flet ((foreign-libraries (&key &allow-other-keys) (status 0 "Reloading foreign libraries.") (flet ((maybe-load (lib) (let ((lib (ensure-library lib)) (sb-ext:*muffled-warnings* (quote style-warning))) (unless (or (library-open-p lib) (library-dont-open-p lib)) (status 1 "Loading foreign library ~a." lib) (open-library lib))))) (dolist (lib *foreign-libraries-to-reload*) (maybe-load lib))))) (function foreign-libraries))) (setf (hook :boot (quote foreign-libraries)) foreign-libraries) (setf (docstring foreign-libraries) nil) (quote foreign-libraries))


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

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

(lambda* nil
  (progn))

[Assistant]
(defmacro LAMBDA* ...)

;; macroexpand:
(lambda () (the t (progn)))


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

Problem: Macro call that should be transformed by COLLECT-MIN

(collect-min 'some-name)

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

;; macroexpand:
(common-lisp:let* ((#:generator-320 (generator 'some-name))
                   #:numbers-314
                   (#:number-316 nil))
  (declare (type generator #:generator-320))
  (tagbody
   #:ll-321
    (setq #:numbers-314 (next-in #:generator-320 (go end)))
    (if (or (null #:number-316) (> #:number-316 #:numbers-314))
        (setq #:number-316 #:numbers-314))
    (go #:ll-321)
   end)
  (if (null #:number-316)
      (setq #:number-316 nil))
  #:number-316)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(is = 5 6)

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

(is = 5 6)

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause-driver (for var in-stream stream &optional using (reader '#'read)) "Forms in a stream (which will be closed at the end)" (top-level-check) (return-stream-driver-code var stream reader :stream generate))

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

(defclause-driver (for var in-stream stream &optional using (reader '#'read)) "Forms in a stream (which will be closed at the end)" (top-level-check) (return-stream-driver-code var stream reader :stream generate))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-for-in-stream-7 (&key ((:for var)) ((:in-stream stream)) ((:using reader) (quote (function read))) generate) "Forms in a stream (which will be closed at the end)" (top-level-check) (return-stream-driver-code var stream reader :stream generate)) (install-clause-info (quote (for :in-stream)) (quote (for :in-stream &optional :using)) (quote clause-for-in-stream-7) "Forms in a stream (which will be closed at the end)" t) (quote (for var in-stream stream &optional using (reader (quote (function read))))))


[User]
Define a macro that eliminates this repetitive pattern:
(defun/1 ungetc (c fd) (handler-case (progn (unread-char (code-char c) (fd-stream fd)) c) (error () (setf (ferror fd) EIO) EOF)))

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

(defun/1 ungetc (c fd) (handler-case (progn (unread-char (code-char c) (fd-stream fd)) c) (error () (setf (ferror fd) EIO) EOF)))

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

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

;; macroexpand:
(progn (defun ungetc (c fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (handler-case (progn (unread-char (code-char c) (fd-stream fd)) c) (error nil (setf (ferror fd) eio) eof))) (defparameter ungetc (vacietis.c:mkptr& (symbol-function (quote ungetc)))))


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

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

(with-yield
  nil
  :key
  nil)

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

;; macroexpand:
(isolate-cont
  (enable-yield
    nil
    nil
    :key
    nil))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(aggregate-scope-progv *string-scope-variables* (aggregate-scope-progv *aggregate-scope-variables* (loop initially (funcall *beginning-of-string-handler*) for c = (read-json-string-char stream) while c do (funcall *string-char-handler* c) finally (return (funcall *end-of-string-handler*)))))

What needs to change: Macro call that should be transformed by aggregate-scope-progv

(aggregate-scope-progv *string-scope-variables* (aggregate-scope-progv *aggregate-scope-variables* (loop initially (funcall *beginning-of-string-handler*) for c = (read-json-string-char stream) while c do (funcall *string-char-handler* c) finally (return (funcall *end-of-string-handler*)))))

[Assistant]
(defmacro aggregate-scope-progv (variables &body body)
  "Establish a dynamic environment where all VARIABLES are freshly
bound (to their current values), and execute BODY in it, returning the
result."
  `(progv ,variables (mapcar #'symbol-value ,variables)
     ,@body))

;; macroexpand:
(progv *string-scope-variables* (mapcar (function symbol-value) *string-scope-variables*) (aggregate-scope-progv *aggregate-scope-variables* (loop initially (funcall *beginning-of-string-handler*) for c = (read-json-string-char stream) while c do (funcall *string-char-handler* c) finally (return (funcall *end-of-string-handler*)))))


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

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

(gatherlet nil)

[Assistant]
(defmacro GATHERLET ...)

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


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

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

(cond->
  'some-name)

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

;; macroexpand:
'some-name


[User]
Define a macro that eliminates this repetitive pattern:
(define-cruft %associate-name-with-readtable (name readtable) "Associate NAME with READTABLE for FIND-READTABLE to work." #+ :allegro (setf (excl:named-readtable (readtable-name-for-allegro name)) readtable) #+ :common-lisp (setf (gethash name *named-readtables*) readtable))

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

(define-cruft %associate-name-with-readtable (name readtable) "Associate NAME with READTABLE for FIND-READTABLE to work." #+ :allegro (setf (excl:named-readtable (readtable-name-for-allegro name)) readtable) #+ :common-lisp (setf (gethash name *named-readtables*) readtable))

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

;; macroexpand:
(progn (declaim (inline %associate-name-with-readtable)) (defun %associate-name-with-readtable (name readtable) "Associate NAME with READTABLE for FIND-READTABLE to work." (setf (gethash name *named-readtables*) readtable)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defjs test_sum() (let ((l (make-array 1 2 3 4)) (sum 0)) (dolist (c l) (incf sum c)) (return sum)))

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

(defjs test_sum() (let ((l (make-array 1 2 3 4)) (sum 0)) (dolist (c l) (incf sum c)) (return sum)))

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

;; macroexpand:
(let* ((js-body (parenscript:ps (lambda nil (let ((l (make-array 1 2 3 4)) (sum 0)) (dolist (c l) (incf sum c)) (return sum)))))) (setf (gethash (quote test_sum) *js-definitions*) js-body) (defun test_sum nil (get-element "retval" (car (docs (db.eval js-body))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defclause (minimize expr &optional into var) "Minimize value of an expression" (return-extremum-code expr var 'min))

Problem: Macro call that should be transformed by defclause

(defclause (minimize expr &optional into var) "Minimize value of an expression" (return-extremum-code expr var 'min))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-minimize-13 (&key ((:minimize expr)) ((:into var))) "Minimize value of an expression" (return-extremum-code expr var (quote min))) (install-clause-info (quote (minimize)) (quote (minimize &optional :into)) (quote clause-minimize-13) "Minimize value of an expression" nil) (quote (minimize expr &optional into var)))


[User]
Generate a defmacro form that transforms code like this:
(with-packages-unlocked nil
  (progn))

Pattern to recognize: Macro call that should be transformed by WITH-PACKAGES-UNLOCKED

(with-packages-unlocked nil
  (progn))

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

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


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

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

(dlet* nil
  :key
  nil)

[Assistant]
(defmacro DLET* ...)

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


[User]
Generate a defmacro form that transforms code like this:
(doseq (elem sequence :from-end from-end :start start :end end) (when (funcall test (funcall key elem)) (incf count)))

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

(doseq (elem sequence :from-end from-end :start start :end end) (when (funcall test (funcall key elem)) (incf count)))

[Assistant]
(defmacro doseq (name/seq &body body)
  "Iterate over the elements of a single sequence SEQUENCE.

   Same as DO-SEQUENCES but for the special case of iterating over a
   single sequence.

   The macro arguments can be in one of the following two forms:

    1. (NAME (ELEMENT SEQUENCE &REST ARGS) &BODY BODY)

    2. ((ELEMENT SEQUENCE &REST ARGS) &BODY BODY)

   NAME is the block name, NIL if not given.

   ELEMENT is the variable to which each element of the sequence is
   bound.

   SEQUENCE is the sequence, with ARGS being the remaining arguments
   passed to the ITERATOR function.

   BODY is the list of forms evaluated on each iteration."

  (let-if ((name name/seq)
           (seq (first body) name/seq)
           (body (rest body) body))
      (symbolp name/seq)

    (destructuring-bind (element sequence &rest args) seq
      `(do-sequences ,name
         ((,element ,sequence ,@args))
         ,@body))))

;; macroexpand:
(do-sequences nil ((elem sequence :from-end from-end :start start :end end)) (when (funcall test (funcall key elem)) (incf count)))


[User]
Define a macro that eliminates this repetitive pattern:
(once-only* args (let ((else `(error 'match-error :values (list ,@args) :patterns ',(mapcar #'car clauses)))) (compile-match args clauses else)))

Issue: Macro call that should be transformed by once-only*

(once-only* args (let ((else `(error 'match-error :values (list ,@args) :patterns ',(mapcar #'car clauses)))) (compile-match args clauses else)))

[Assistant]
(defmacro once-only* (symbol &body body)
  (with-unique-names (form var vars bindings)
    `(let (,vars ,bindings)
       (dolist (,form ,symbol)
         (if (symbolp ,form)
             (push ,form ,vars)
             (let ((,var (gensym "VAR")))
               (push ,var ,vars)
               (push (list ,var ,form) ,bindings))))
       (setq ,vars (nreverse ,vars)
             ,bindings (nreverse ,bindings))
       (if ,bindings
           `(let ,,bindings
              ;(declare (ignorable ,@(mapcar #'car ,bindings)))
              ,(let ((,symbol ,vars))
                 ,@body))
           (progn ,@body)))))

;; macroexpand:
(let (#:vars166 #:bindings167) (dolist (#:form164 args) (if (symbolp #:form164) (push #:form164 #:vars166) (let ((#:var165 (gensym "VAR"))) (push #:var165 #:vars166) (push (list #:var165 #:form164) #:bindings167)))) (setq #:vars166 (nreverse #:vars166) #:bindings167 (nreverse #:bindings167)) (if #:bindings167 (sb-int:quasiquote (let #S(sb-impl::comma :expr #:bindings167 :kind 0) #S(sb-impl::comma :expr (let ((args #:vars166)) (let ((else (sb-int:quasiquote (error (quote match-error) :values (list #S(sb-impl::comma :expr args :kind 2)) :patterns (quote #S(sb-impl::comma :expr (mapcar (function car) clauses) :kind 0)))))) (compile-match args clauses else))) :kind 0))) (progn (let ((else (sb-int:quasiquote (error (quote match-error) :values (list #S(sb-impl::comma :expr args :kind 2)) :patterns (quote #S(sb-impl::comma :expr (mapcar (function car) clauses) :kind 0)))))) (compile-match args clauses else)))))


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

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

(keep-bops 'some-name)

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

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


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

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

(f_n)

[Assistant]
(defmacro F_N ...)

;; macroexpand:
(lambda (&rest _))


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

Problem: Macro call that should be transformed by $+

($+ result)

[Assistant]
(defmacro $+ (arg &rest args)
  `(construct-$+- +1 ,arg ,@args))

;; macroexpand:
(construct-$+- 1 result)


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

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

(min-of nil)

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

;; macroexpand:
(lc (nil) minimize)


[User]
Define a macro that eliminates this repetitive pattern:
(secase (car x) (:y (setf it :no)))

Issue: Macro call that should be transformed by secase

(secase (car x) (:y (setf it :no)))

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

;; macroexpand:
(symbolic ecase (car x) (:y (setf it :no)))


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

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

(define-op (:= infix-op))

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

;; macroexpand:
(defstruct (=-op (:include infix-op (name "=")) (:constructor make-=-op (left right))))


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

Issue: 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:
(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:writable-accessors (my-a a) (my-c c) (d the-d)) obj)) (setf my-a 42) (list d my-c my-a (a obj)))

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

(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:writable-accessors (my-a a) (my-c c) (d the-d)) obj)) (setf my-a 42) (list d my-c my-a (a obj)))

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

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

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

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

;; macroexpand:
(let* ((obj (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (#:|values-177| obj)) (declare (ignorable #:|values-177|)) (with-accessors ((my-a a) (my-c c) (d the-d)) #:|values-177| (progn (setf my-a 42) (list d my-c my-a (a obj)))))


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

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

(ƒ→ nil :key nil)

[Assistant]
(defmacro Ƒ→ ...)

;; macroexpand:
(defn nil :key (&optional α)
      (let ((α (or α t)))
        (cond)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-generic generic (a b &key c) (declare (optimize (speed 1))) (+ a b c))

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

(define-generic generic (a b &key c) (declare (optimize (speed 1))) (+ a b c))

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

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

Example:

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

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

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

;; macroexpand:
(prog1 (defgeneric generic (a b &key c) (declare (optimize (speed 1))) (:method (a b &key c) (declare (optimize (speed 1))) (+ a b c))))


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

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

(cond-<>
  nil
  :key
  nil)

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

;; macroexpand:
(let* ((#:var138 nil)
       (#:var139
        (if :key
            (-<>
              #:var138)
            #:var138))
       (#:var140
        (if nil
            (-<>
              #:var139)
            #:var139)))
  #:var140)


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

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

(is (plusp 0))

[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 ((#:v191 0)) (if (plusp #:v191) (add-result (quote test-passed) :test-expr (quote (plusp 0))) (process-failure (quote (plusp 0)) "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%" (quote 0) #:v191 (quote plusp))))


[User]
Generate a defmacro form that transforms code like this:
(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))))))

Pattern to recognize: 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)
  "Cf. `lret'."
  `(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]
Write a Common Lisp macro to handle this code pattern:
(letmatch nil
    :key
  nil)

Problem: Macro call that should be transformed by LETMATCH

(letmatch nil
    :key
  nil)

[Assistant]
(defmacro LETMATCH ...)

;; macroexpand:
(ifmatch (nil :key nil (error "LETMATCH:  mismatch.")))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(match list ((list x) when (oddp x) x))

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

(match list ((list x) when (oddp x) x))

[Assistant]
(defmacro match (arg &body clauses)
  "Matches ARG with CLAUSES. CLAUSES is a list of the form of (PATTERN
. BODY) where PATTERN is a pattern specifier and BODY is an implicit
progn. If ARG matches some PATTERN, `match` then evaluates
the corresponding BODY and returns the evaluated value.  If no pattern matches,
then returns NIL.

Evaluating a form (FAIL) in the clause body causes the latest pattern
matching to fail. For example,

    (match 1
      (x (if (eql x 1)
             (fail)
             x))
      (_ 'ok))

returns OK, because the form (FAIL) in the first clause is
evaluated.

If BODY starts with the symbols WHEN or UNLESS, then the next form
will be used to introduce (FAIL). That is,

    (match list ((list x) when (oddp x) x))
    (match list ((list x) unless (evenp x) x))

will be translated to

    (match list ((list x) (if (oddp x) x (fail))))
    (match list ((list x) (if (evenp x) (fail) x)))

Examples:

    (match 1 (1 1))
    => 1
    (match 1 (2 2))
    => 2
    (match 1 (x x))
    => 1
    (match (list 1 2 3)
      (list x y z) (+ x y z))
    => 6"
  (compile-match-1 arg clauses nil))

;; macroexpand:
(%or (%if (consp list) (let ((#:g140 (car list)) (#:g141 (cdr list))) (declare (ignorable #:g140 #:g141)) (%if (%equals #:g141 nil) (%or (let ((x #:g140)) (if (oddp x) x (fail))) (fail)) (fail))) (fail)) nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclass/std unknown () ((slot :unknown keywords :without-values)))

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

(defclass/std unknown () ((slot :unknown keywords :without-values)))

[Assistant]
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

;; macroexpand:
(defclass unknown nil ((slot :accessor slot :initarg :slot :initform nil :unknown keywords :without-values)))


[User]
Write a Common Lisp macro to handle this code pattern:
(when (eql (top-sign) 'skip-first-funcall) (pop-sign))

Problem: Macro call that should be transformed by when

(when (eql (top-sign) 'skip-first-funcall) (pop-sign))

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

;; macroexpand:
(if (eql (top-sign) (quote skip-first-funcall)) (pop-sign))


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

What needs to change: Macro call that should be transformed by WITHOUT-SYMBOL-ACCESS

(without-symbol-access
  nil
  (progn))

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(defsynonym repeat :repeat)

Issue: Macro call that should be transformed by defsynonym

(defsynonym repeat :repeat)

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

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


[User]
Generate a defmacro form that transforms code like this:
(defun-compile-time screamer-error (header &rest args) (apply #'error (concatenate 'string header "~2%There are eight types of nondeterministic contexts: 1. the body of a function defined with SCREAMER::DEFUN 2. the body of a FOR-EFFECTS macro invocation 3. the body of an ALL-VALUES macro invocation 4. the first argument of a ONE-VALUE macro invocation 5. the body of a PRINT-VALUES macro invocation 6. the second argument of an ITH-VALUE macro invocation 7. the body of a POSSIBLY? macro invocation 8. the body of a NECESSARILY? macro invocation. Note that the default forms of &OPTIONAL and &KEY arguments and the initialization forms of &AUX variables are always deterministic contexts even though they may appear inside a SCREAMER::DEFUN.") args))

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

(defun-compile-time screamer-error (header &rest args) (apply #'error (concatenate 'string header "~2%There are eight types of nondeterministic contexts: 1. the body of a function defined with SCREAMER::DEFUN 2. the body of a FOR-EFFECTS macro invocation 3. the body of an ALL-VALUES macro invocation 4. the first argument of a ONE-VALUE macro invocation 5. the body of a PRINT-VALUES macro invocation 6. the second argument of an ITH-VALUE macro invocation 7. the body of a POSSIBLY? macro invocation 8. the body of a NECESSARILY? macro invocation. Note that the default forms of &OPTIONAL and &KEY arguments and the initialization forms of &AUX variables are always deterministic contexts even though they may appear inside a SCREAMER::DEFUN.") args))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun screamer-error (header &rest args) (apply (function error) (concatenate (quote string) header "~2%There are eight types of nondeterministic contexts: 1. the body of a function defined with SCREAMER::DEFUN 2. the body of a FOR-EFFECTS macro invocation 3. the body of an ALL-VALUES macro invocation 4. the first argument of a ONE-VALUE macro invocation 5. the body of a PRINT-VALUES macro invocation 6. the second argument of an ITH-VALUE macro invocation 7. the body of a POSSIBLY? macro invocation 8. the body of a NECESSARILY? macro invocation. Note that the default forms of &OPTIONAL and &KEY arguments and the initialization forms of &AUX variables are always deterministic contexts even though they may appear inside a SCREAMER::DEFUN.") args)) (eval-when (:compile-toplevel) (compile (quote screamer-error))))


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

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

(dynamic-progv nil
    (progn))

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

;; macroexpand:
(let* ((#:fixed-symbols238 nil)
       (#:fixed-bindings239 (compute-bindings #:fixed-symbols238 (progn))))
  (dynamic-wind
    :proceed
    #:proceed240
    (progv #:fixed-symbols238 #:fixed-bindings239 (#:proceed240))))


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


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

Problem: Macro call that should be transformed by receive

(receive () (values 1))

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

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

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

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

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

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

;; macroexpand:
(multiple-value-call (lambda nil) (values 1))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(-> :g () (put 1) 2)

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

(-> :g () (put 1) 2)

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

;; macroexpand:
(atomically :g nil (put 1) 2)


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

Problem: Macro call that should be transformed by DESTRUCTURING-METHODS

(destructuring-methods nil
    nil)

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

;; macroexpand:
(let ((#:g131 nil))
  (typecase #:g131 ((not list) nil)))


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

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

(some-<> 'some-name)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(defhandler function (function name) `(list ',function ,(if (function-name-p name) `',name (e name))))

Problem: Macro call that should be transformed by defhandler

(defhandler function (function name) `(list ',function ,(if (function-name-p name) `',name (e name))))

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

;; macroexpand:
(progn (defun hander-function (function name) (sb-int:quasiquote (list (quote #S(sb-impl::comma :expr function :kind 0)) #S(sb-impl::comma :expr (if (function-name-p name) (sb-int:quasiquote (quote #S(sb-impl::comma :expr name :kind 0))) (e name)) :kind 0)))) (setf (gethash (quote function) *form-handler*) (quote hander-function)))


[User]
Generate a defmacro form that transforms code like this:
(def-iter iterator-zip (iterator-vec n) (zip-from-itl (itl-of-itls) (let* ((itl-of-itls (iter-to-vec itl-of-itls)) (n (length itl-of-itls))) (loop for i below n do (setf (aref itl-of-itls i) (make-iterator (aref itl-of-itls i)))) (if (zerop n) (empty-iterator) (init-state (iterator-vec itl-of-itls) n)))) (loop with alive = t for i below n with ret-vec = (make-array n) while alive do (multiple-value-bind (iter-item iter-alive) (next (aref iterator-vec i)) (setf alive iter-alive) (setf (aref ret-vec i) iter-item)) finally (return (if alive (values ret-vec t) (values nil nil)))))

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

(def-iter iterator-zip (iterator-vec n) (zip-from-itl (itl-of-itls) (let* ((itl-of-itls (iter-to-vec itl-of-itls)) (n (length itl-of-itls))) (loop for i below n do (setf (aref itl-of-itls i) (make-iterator (aref itl-of-itls i)))) (if (zerop n) (empty-iterator) (init-state (iterator-vec itl-of-itls) n)))) (loop with alive = t for i below n with ret-vec = (make-array n) while alive do (multiple-value-bind (iter-item iter-alive) (next (aref iterator-vec i)) (setf alive iter-alive) (setf (aref ret-vec i) iter-item)) finally (return (if alive (values ret-vec t) (values nil nil)))))

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

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

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

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

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

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

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

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

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

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

;; macroexpand:
(labels ((#:next-fname136 (&key iterator-vec n) (labels ((self nil (loop with alive = t for i below n with ret-vec = (make-array n) while alive do (multiple-value-bind (iter-item iter-alive) (next (aref iterator-vec i)) (setf alive iter-alive) (setf (aref ret-vec i) iter-item)) finally (return (if alive (values ret-vec t) (values nil nil)))))) (function self)))) (defun zip-from-itl (itl-of-itls) "Function had no docstring, so this one was inserted" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname136)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (let* ((itl-of-itls (iter-to-vec itl-of-itls)) (n (length itl-of-itls))) (loop for i below n do (setf (aref itl-of-itls i) (make-iterator (aref itl-of-itls i)))) (if (zerop n) (empty-iterator) (init-state (iterator-vec itl-of-itls) n))))))


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

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

(with-active-layers nil
  :key
  nil)

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

;; macroexpand:
(progn :key nil)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-element-maker :linear-gradient "linearGradient" '(:id :x1 :y1 :x2 :y2))

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

(define-element-maker :linear-gradient "linearGradient" '(:id :x1 :y1 :x2 :y2))

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


[User]
Generate a defmacro form that transforms code like this:
(enable-string-quote-syntax)

Pattern to recognize: Macro call that should be transformed by ENABLE-STRING-QUOTE-SYNTAX

(enable-string-quote-syntax)

[Assistant]
(defmacro ENABLE-STRING-QUOTE-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-string-quote-syntax-in-readtable :start-character
                                        #\HALFWIDTH_LEFT_CORNER_BRACKET
                                        :end-character
                                        #\HALFWIDTH_RIGHT_CORNER_BRACKET
                                        :transformer #'identity)
  (values))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(deferror "XX" internal-error)

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

(deferror "XX" internal-error)

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

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


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

Problem: Macro call that should be transformed by DRELET*

(drelet* nil
  nil)

[Assistant]
(defmacro DRELET* ...)

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


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

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

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

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

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


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

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

(f_n
  'some-name)

[Assistant]
(defmacro F_N ...)

;; macroexpand:
(lambda (&rest _) 'some-name)


[User]
Define a macro that eliminates this repetitive pattern:
(is-error (error "Raising an error") 'simple-error)

Issue: Macro call that should be transformed by is

(is-error (error "Raising an error") 'simple-error)

[Assistant]
(defmacro is (got expected &rest args)
  (with-gensyms (duration result new-args desc)
    (once-only (expected)
      `(let* ((,new-args (list ,@args))
              (,desc (parse-description-and-test ,new-args)))
         (with-catching-errors (:description ,desc :expected ,expected)
           (with-duration ((,duration ,result) ,got)
             (test ,result ,expected ,new-args
                   :duration ,duration)))))))

;; macroexpand:
(with-duration ((#:duration182 #:error181) (handler-case (error "Raising an error") (condition (#:error181) #:error181))) (test #:error181 (quote simple-error) nil :duration #:duration182 :got-form (quote (error "Raising an error")) :test-fn (function typep) :report-expected-label "raise a condition"))