Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvar-compile-time *tagbody-tags* '() "This must be globally NIL.")

Write a macro that addresses: Macro call that should be transformed by defvar-compile-time

Input: (defvar-compile-time *tagbody-tags* '() "This must be globally NIL.")

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *tagbody-tags* (quote nil) "This must be globally NIL."))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(f 'some-name)

Problem: Macro call that should be transformed by F

Input: (f 'some-name)

Output: (defmacro F ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(bdd-typecase 'some-name)

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

Input: (bdd-typecase 'some-name)

Output: (defmacro BDD-TYPECASE ...)

((lambda (#:obj165)
   (declare (ignorable #:obj165))
   (block #:block166 (tagbody)))
 'some-name)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(collect-hash nil (progn))

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

Input: (collect-hash nil (progn))

Output: (defmacro COLLECT-HASH ...)

(common-lisp:let* ((#:out-149 (make-hash-table)))
  (common-lisp:let ((#:generator-153 (generator (progn)))
                    #:values-145
                    (#:generator-151 (generator nil))
                    #:keys-144)
    (declare (type generator #:generator-153)
             (type generator #:generator-151))
    (tagbody
     #:ll-154
      (setq #:values-145 (next-in #:generator-153 (go end)))
      (setq #:keys-144 (next-in #:generator-151 (go end)))
      (setf (gethash #:keys-144 #:out-149) #:values-145)
      (go #:ll-154)
     end)
    #:out-149))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error unknown-type-spec () (type-spec) "Could not find the correct type for type-spec ~s~@[ ~a~]~%~a" type-spec (when (typep type-spec 'v-type) (format nil "~%It seems we recieved a type object instead of type spec")) (let ((found (find-alternative-types-for-spec type-spec))) (if found (format nil "~%Perhaps you meant one of these types?:~%~(~{~s~%~}~)" found) "")))

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

Input: (define-error unknown-type-spec () (type-spec) "Could not find the correct type for type-spec ~s~@[ ~a~]~%~a" type-spec (when (typep type-spec 'v-type) (format nil "~%It seems we recieved a type object instead of type spec")) (let ((found (find-alternative-types-for-spec type-spec))) (if found (format nil "~%Perhaps you meant one of these types?:~%~(~{~s~%~}~)" found) "")))

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

(defcondition unknown-type-spec (:error-type varjo-error :prefix "Varjo") (type-spec) "Could not find the correct type for type-spec ~s~@[ ~a~]~%~a" type-spec (when (typep type-spec (quote v-type)) (format nil "~%It seems we recieved a type object instead of type spec")) (let ((found (find-alternative-types-for-spec type-spec))) (if found (format nil "~%Perhaps you meant one of these types?:~%~(~{~s~%~}~)" found) "")))


Instruction:
Generate a defmacro form that transforms code like this:
(def-dynenv-macro nil
    nil)

Pattern to recognize: Macro call that should be transformed by DEF-DYNENV-MACRO

Input:
(def-dynenv-macro nil
    nil)

Output: (defmacro DEF-DYNENV-MACRO ...)

(defmacro nil (&environment #:env174) (with-dynenv #:env174))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(deferror "08007" transaction-resolution-unknown)

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

Input: (deferror "08007" transaction-resolution-unknown)

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

(progn (define-condition transaction-resolution-unknown (database-error) nil) (setf (gethash "08007" *error-table*) (quote transaction-resolution-unknown)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(failure NIL)

Problem: Macro call that should be transformed by fail

Input: (failure NIL)

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(flow-lambda-macro (flow-context) `(flet ((,test-fu () ,live-test-form)) (dispatch-repeatedly ,flow-context #',test-fu ,flow-list)))

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

Input: (flow-lambda-macro (flow-context) `(flet ((,test-fu () ,live-test-form)) (dispatch-repeatedly ,flow-context #',test-fu ,flow-list)))

Output:
(defmacro flow-lambda-macro ((flow-context) &body body)
  `(with-gensyms (,flow-context)
     `(%flow-lambda (,,flow-context)
        ,,@body)))

(with-gensyms (flow-context) (sb-int:quasiquote (%flow-lambda (#S(sb-impl::comma :expr flow-context :kind 0)) #S(sb-impl::comma :expr (sb-int:quasiquote (flet ((#S(sb-impl::comma :expr test-fu :kind 0) nil #S(sb-impl::comma :expr live-test-form :kind 0))) (dispatch-repeatedly #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr test-fu :kind 0)) #S(sb-impl::comma :expr flow-list :kind 0)))) :kind 0))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym :reducing :reduce)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym :reducing :reduce)

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

(eval-always (setf (get (quote :reducing) (quote synonym)) (quote :reduce)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-interleaving `(with-interleaving ,@(loop for part in (rest form) collect (remove-bindings bindings part))))

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

Input: (with-interleaving `(with-interleaving ,@(loop for part in (rest form) collect (remove-bindings bindings part))))

Output:
(defmacro with-interleaving (&body body)
  (let* ((root (copy-list (pop body)))
         (current root))
    (dolist (form body root)
      (let ((form (copy-list form)))
        (when form
          (setf (cdr (last current)) (cons form NIL))
          (setf current form))))))

(sb-int:quasiquote (with-interleaving #S(sb-impl::comma :expr (loop for part in (rest form) collect (remove-bindings bindings part)) :kind 2)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(f nil
  (progn))

Issue: Macro call that should be transformed by F

Input:
(f nil
  (progn))

Output: (defmacro F ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(enable-readtime-wrapper-syntax nil (progn))

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

Input: (enable-readtime-wrapper-syntax nil (progn))

Output: (defmacro ENABLE-READTIME-WRAPPER-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-readtime-wrapper-syntax-in-readtable nil (progn))
  (values))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(quasiquote-expand-1 'list (butlast x))

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

Input: (quasiquote-expand-1 'list (butlast x))

Output: (defmacro quasiquote (x) (quasiquote-expand x))

(quasiquote-expand-1 (quote list) (butlast x))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym :with with)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym :with with)

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

(eval-always (setf (get (quote :with) (quote synonym)) (quote with)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defstore example (a &optional (b (the real (compute-default a))) (c (the real (1+ b)))))

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

Input: (defstore example (a &optional (b (the real (compute-default a))) (c (the real (1+ b)))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (defun a-init-function152 (a) (declare (ignorable a)) (the real (compute-default a))) (defun b-init-function154 (a b #:b?160) (declare (ignorable a b #:b?160)) (the real (1+ b))) (ensure-store (quote example) (quote (a &optional (b (the real (a-init-function152 a)) #:b?160) (c (the real (b-init-function154 a b #:b?160)) #:c?161))))))


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

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

Input: (-<>> 'some-name)

Output: (defmacro -<>> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(action (:traverse node-application node bound-variables) (unless (tracked-variable-p (node-application-rator node) bound-variables) (funcall *traverse* (node-application-rator node) bound-variables)) (loop :for rand :in (node-application-rands node) :do (funcall *traverse* rand bound-variables)) (traverse-keyword-rands (node-application-keyword-rands node) bound-variables) node)

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

Input: (action (:traverse node-application node bound-variables) (unless (tracked-variable-p (node-application-rator node) bound-variables) (funcall *traverse* (node-application-rator node) bound-variables)) (loop :for rand :in (node-application-rands node) :do (funcall *traverse* rand bound-variables)) (traverse-keyword-rands (node-application-keyword-rands node) bound-variables) node)

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

(make-action (quote :traverse) (quote node-application) (lambda (node bound-variables) (declare (type node-application node)) (unless (tracked-variable-p (node-application-rator node) bound-variables) (funcall *traverse* (node-application-rator node) bound-variables)) (loop :for rand :in (node-application-rands node) :do (funcall *traverse* rand bound-variables)) (traverse-keyword-rands (node-application-keyword-rands node) bound-variables) node))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ps-doc
  'some-name)

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

Input:
(ps-doc
  'some-name)

Output: (defmacro PS-DOC ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ƒ→ nil nil)

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

Input: (ƒ→ nil nil)

Output: (defmacro Ƒ→ ...)

(defn nil nil (&optional α)
      (let ((α (or α t)))
        (cond)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-cruft %unassociate-name-from-readtable (name readtable) "Remove the association between NAME and READTABLE" #+ :allegro (let ((n (readtable-name-for-allegro name))) (assert (eq readtable (excl:named-readtable n))) (setf (excl:named-readtable n) nil)) #+ :common-lisp (progn (assert (eq readtable (gethash name *named-readtables*))) (remhash name *named-readtables*)))

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

Input: (define-cruft %unassociate-name-from-readtable (name readtable) "Remove the association between NAME and READTABLE" #+ :allegro (let ((n (readtable-name-for-allegro name))) (assert (eq readtable (excl:named-readtable n))) (setf (excl:named-readtable n) nil)) #+ :common-lisp (progn (assert (eq readtable (gethash name *named-readtables*))) (remhash name *named-readtables*)))

Output:
(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))))

(progn (declaim (inline %unassociate-name-from-readtable)) (defun %unassociate-name-from-readtable (name readtable) "Remove the association between NAME and READTABLE" (progn (assert (eq readtable (gethash name *named-readtables*))) (remhash name *named-readtables*))))


Instruction:
Generate a defmacro form that transforms code like this:
(-> :tag-2 ((a b)) (concatenate 'string a b " World!"))

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

Input: (-> :tag-2 ((a b)) (concatenate 'string a b " World!"))

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

(atomically :tag-2 ((a b)) (concatenate (quote string) a b " World!"))


Instruction:
Generate a defmacro form that transforms code like this:
(without-package-lock (:common-lisp #+lispworks :implementation) (defmethod documentation ((name symbol) (doc-type (eql 'readtable))) (let ((readtable (find-readtable name))) (and readtable (gethash readtable *readtable-to-docstring*)))) (defmethod documentation ((readtable readtable) (doc-type (eql 'readtable))) (gethash readtable *readtable-to-docstring*)) (defmethod (setf documentation) (docstring (name symbol) (doc-type (eql 'readtable))) (let ((readtable (find-readtable name))) (unless readtable (error 'readtable-does-not-exist :readtable-name name)) (setf (gethash readtable *readtable-to-docstring*) docstring))) (defmethod (setf documentation) (docstring (readtable readtable) (doc-type (eql 'readtable))) (setf (gethash readtable *readtable-to-docstring*) docstring)))

Pattern to recognize: Macro call that should be transformed by without-package-lock

Input: (without-package-lock (:common-lisp #+lispworks :implementation) (defmethod documentation ((name symbol) (doc-type (eql 'readtable))) (let ((readtable (find-readtable name))) (and readtable (gethash readtable *readtable-to-docstring*)))) (defmethod documentation ((readtable readtable) (doc-type (eql 'readtable))) (gethash readtable *readtable-to-docstring*)) (defmethod (setf documentation) (docstring (name symbol) (doc-type (eql 'readtable))) (let ((readtable (find-readtable name))) (unless readtable (error 'readtable-does-not-exist :readtable-name name)) (setf (gethash readtable *readtable-to-docstring*) docstring))) (defmethod (setf documentation) (docstring (readtable readtable) (doc-type (eql 'readtable))) (setf (gethash readtable *readtable-to-docstring*) docstring)))

Output:
(defmacro without-package-lock ((&rest package-names) &body body)
  (declare (ignorable package-names))
  #+clisp
  (return-from without-package-lock
    `(ext:without-package-lock (,@package-names) ,@body))
  #+lispworks
  (return-from without-package-lock
    `(let ((hcl:*packages-for-warn-on-redefinition*
             (set-difference hcl:*packages-for-warn-on-redefinition*
                             '(,@package-names)
                             :key (lambda (package-designator)
                                    (if (packagep package-designator)
                                        (package-name package-designator)
                                        package-designator))
                             :test #'string=)))
       ,@body))
  `(progn ,@body))

(progn (defmethod documentation ((name symbol) (doc-type (eql (quote readtable)))) (let ((readtable (find-readtable name))) (and readtable (gethash readtable *readtable-to-docstring*)))) (defmethod documentation ((readtable readtable) (doc-type (eql (quote readtable)))) (gethash readtable *readtable-to-docstring*)) (defmethod (setf documentation) (docstring (name symbol) (doc-type (eql (quote readtable)))) (let ((readtable (find-readtable name))) (unless readtable (error (quote readtable-does-not-exist) :readtable-name name)) (setf (gethash readtable *readtable-to-docstring*) docstring))) (defmethod (setf documentation) (docstring (readtable readtable) (doc-type (eql (quote readtable)))) (setf (gethash readtable *readtable-to-docstring*) docstring)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-component-testers (a b #'pathname-type) (components-are-member '(nil :wild :unspecific)) (components-are-string=))

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

Input: (with-component-testers (a b #'pathname-type) (components-are-member '(nil :wild :unspecific)) (components-are-string=))

Output:
(defmacro with-component-testers ((a b key) &body body)
  (let ((k (gensym)))
    `(let* ((,k ,key)
            (,a (funcall ,k ,a))
            (,b (funcall ,k ,b)))
       (labels ((components-are (test)
                  (and (funcall test ,a) (funcall test ,b)))
                (components-are-member (values)
                  (and (member ,a values :test #'eql)
                       (member ,b values :test #'eql)
                       (eql ,a ,b)))
                (components-are-string= ()
                  (and (stringp ,a) (stringp ,b) (string= ,a ,b)))
                (components-are-every (test)
                  (and (consp ,a)
                       (consp ,b)
                       (every test ,a ,b))))
         (declare (ignorable #'components-are #'components-are-member
                             #'components-are-string= #'components-are-every))
         (if (or ,@body)
             (values t ,a ,b)
             nil)))))

(let* ((#:g147 (function pathname-type)) (a (funcall #:g147 a)) (b (funcall #:g147 b))) (labels ((components-are (test) (and (funcall test a) (funcall test b))) (components-are-member (values) (and (member a values :test (function eql)) (member b values :test (function eql)) (eql a b))) (components-are-string= nil (and (stringp a) (stringp b) (string= a b))) (components-are-every (test) (and (consp a) (consp b) (every test a b)))) (declare (ignorable (function components-are) (function components-are-member) (function components-are-string=) (function components-are-every))) (if (or (components-are-member (quote (nil :wild :unspecific))) (components-are-string=)) (values t a b) nil)))


Instruction:
Generate a defmacro form that transforms code like this:
(c? (when (kv-collector self) (funcall (kv-collector self) (^value))))

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

Input: (c? (when (kv-collector self) (funcall (kv-collector self) (^value))))

Output:
(defmacro c? (&body body)
  `(make-c-dependent
    :code ',body
    :value-state :unevaluated
    :rule (c-lambda ,@body)))

(make-c-dependent :code (quote ((when (kv-collector self) (funcall (kv-collector self) (^value))))) :value-state :unevaluated :rule (c-lambda (when (kv-collector self) (funcall (kv-collector self) (^value)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "23001" restrict-violation integrity-violation)

Issue: Macro call that should be transformed by deferror

Input: (deferror "23001" restrict-violation integrity-violation)

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

(progn (define-condition restrict-violation (integrity-violation) nil) (setf (gethash "23001" *error-table*) (quote restrict-violation)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(undefreply nil)

Problem: Macro call that should be transformed by UNDEFREPLY

Input: (undefreply nil)

Output: (defmacro UNDEFREPLY ...)

(undefine-reply 'nil :qualifiers 'nil :participants `nil)


Instruction:
Generate a defmacro form that transforms code like this:
(when (node-slot shared) (make-proxy shared comma))

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

Input: (when (node-slot shared) (make-proxy shared comma))

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

(if (node-slot shared) (make-proxy shared comma))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(keep-bops nil)

Problem: Macro call that should be transformed by KEEP-BOPS

Input: (keep-bops nil)

Output: (defmacro KEEP-BOPS ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(match0 (remove nil (list (hyphened) (concname) (nameonly))) ((list sym) sym) ((list) nil) (readers (ambiguous-slot-error "Multiple candidates of the accessor function: ~{~a~^, ~}" readers)))

Problem: Macro call that should be transformed by match0

Input: (match0 (remove nil (list (hyphened) (concname) (nameonly))) ((list sym) sym) ((list) nil) (readers (ambiguous-slot-error "Multiple candidates of the accessor function: ~{~a~^, ~}" readers)))

Output:
(defmacro match0 (*what* &body clauses &environment *env*)
  (once-only (*what*)
    (parse-patterns clauses)))

(let ((#:*what*158 (remove nil (list (hyphened) (concname) (nameonly))))) (declare (ignorable #:*what*158)) (if (and (consp #:*what*158) (let ((#:*what*159 (car #:*what*158))) (declare (ignorable #:*what*159)) t) (let ((#:*what*160 (cdr #:*what*158))) (declare (ignorable #:*what*160)) (equal #:*what*160 nil))) (let* ((#:*what*159 (car #:*what*158)) (sym #:*what*159) (#:*what*160 (cdr #:*what*158))) (declare (ignorable #:*what*160 sym #:*what*159)) sym) (if (null #:*what*158) (let* nil (declare (ignorable)) nil) (if t (let* ((readers #:*what*158)) (declare (ignorable readers)) (ambiguous-slot-error "Multiple candidates of the accessor function: ~{~a~^, ~}" readers)) nil))))


Instruction:
Generate a defmacro form that transforms code like this:
(*let nil
  nil)

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

Input:
(*let nil
  nil)

Output: (defmacro *LET ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-custom-var (:object-value *object-value-handler*))

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

Input: (define-custom-var (:object-value *object-value-handler*))

Output:
(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))))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*object-value-handler* . :object-value)) *custom-vars* :test (function equal)) (defvar *object-value-handler*)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(assert-values ("deleted foo") (foo 'nothing) (foo+1 'nothing) (bar 2) (bar-1 1))

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

Input: (assert-values ("deleted foo") (foo 'nothing) (foo+1 'nothing) (bar 2) (bar-1 1))

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

(progn (trc "deleted foo") (assert (eql (value foo) (quote nothing))) (assert (eql (value foo+1) (quote nothing))) (assert (eql (value bar) 2)) (assert (eql (value bar-1) 1)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(λλ)

Issue: Macro call that should be transformed by ΛΛ

Input: (λλ)

Output: (defmacro ΛΛ ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(collect-product 'some-name)

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

Input: (collect-product 'some-name)

Output: (defmacro COLLECT-PRODUCT ...)

(common-lisp:let* ((#:generator-131 (generator 'some-name))
                   #:numbers-127
                   (#:mul-128 1))
  (declare (type generator #:generator-131)
           (type number #:mul-128))
  (tagbody
   #:ll-132
    (setq #:numbers-127 (next-in #:generator-131 (go end)))
    (setq #:mul-128 (* #:mul-128 #:numbers-127))
    (go #:ll-132)
   end)
  #:mul-128)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-notation bind-maybe ((sum nothing) (str (maybe->string sum))) (print str))

Problem: Macro call that should be transformed by do-notation

Input: (do-notation bind-maybe ((sum nothing) (str (maybe->string sum))) (print str))

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

(progn (bind-maybe (lambda (sum) (bind-maybe (lambda (str) (print str)) (maybe->string sum))) nothing))


Instruction:
Define a macro that eliminates this repetitive pattern:
(action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq))) (copy-node value (node-type node))))

Issue: Macro call that should be transformed by action

Input: (action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq))) (copy-node value (node-type node))))

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

(make-action (quote :after) (quote node-variable) (lambda (node bound-variables) (declare (type node-variable node)) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test (function eq)))) (copy-node value (node-type node)))))


Instruction:
Generate a defmacro form that transforms code like this:
(defsynonym next :next)

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

Input: (defsynonym next :next)

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

(eval-always (setf (get (quote next) (quote synonym)) (quote :next)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(count-of nil
  (progn))

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

Input:
(count-of nil
  (progn))

Output: (defmacro COUNT-OF ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-cached-reader-conditionals)

What needs to change: Macro call that should be transformed by WITH-CACHED-READER-CONDITIONALS

Input: (with-cached-reader-conditionals)

Output: (defmacro WITH-CACHED-READER-CONDITIONALS ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> (char #\\) (alt (<$ #\newline (char #\n)) (<$ #\tab (char #\t)) (<$ #\return (char #\r)) (<$ #\backspace (char #\b)) (<$ #\page (char #\f))))

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

Input: (*> (char #\\) (alt (<$ #\newline (char #\n)) (<$ #\tab (char #\t)) (<$ #\return (char #\r)) (<$ #\backspace (char #\b)) (<$ #\page (char #\f))))

Output:
(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)))))

(lambda (#:*>-offset197) (multiple-value-bind (#:*>-res198 #:*>-next199) (funcall (char #\REVERSE_SOLIDUS) #:*>-offset197) (if (ok? #:*>-res198) (funcall (alt (<$ #\Newline (char #\LATIN_SMALL_LETTER_N)) (<$ #\Tab (char #\LATIN_SMALL_LETTER_T)) (<$ #\Return (char #\LATIN_SMALL_LETTER_R)) (<$ #\Backspace (char #\LATIN_SMALL_LETTER_B)) (<$ #\Page (char #\LATIN_SMALL_LETTER_F))) #:*>-next199) (fail #:*>-next199))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(some-<>>)

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

Input: (some-<>>)

Output: (defmacro SOME-<>> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(c? (1+ (^m-cyc2-a)))

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

Input: (c? (1+ (^m-cyc2-a)))

Output:
(defmacro c? (&body body)
  `(make-c-dependent
    :code ',body
    :value-state :unevaluated
    :rule (c-lambda ,@body)))

(make-c-dependent :code (quote ((1+ (^m-cyc2-a)))) :value-state :unevaluated :rule (c-lambda (1+ (^m-cyc2-a))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (if (cdr (conjunctive-op-expressions op)) (format nil (format nil "(~~{~~A~~^ ~A ~~})" (sql-op-name op)) (mapcar #'yield (conjunctive-op-expressions op))) (yield (car (conjunctive-op-expressions op)))))

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

Input: (with-yield-binds (if (cdr (conjunctive-op-expressions op)) (format nil (format nil "(~~{~~A~~^ ~A ~~})" (sql-op-name op)) (mapcar #'yield (conjunctive-op-expressions op))) (yield (car (conjunctive-op-expressions op)))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (if (cdr (conjunctive-op-expressions op)) (format nil (format nil "(~~{~~A~~^ ~A ~~})" (sql-op-name op)) (mapcar (function yield) (conjunctive-op-expressions op))) (yield (car (conjunctive-op-expressions op))))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(parse-conjunctive-clauses client instance t)

Problem: Macro call that should be transformed by parse-conjunctive-clauses

Input: (parse-conjunctive-clauses client instance t)

Output:
(defmacro parse-conjunctive-clauses (client region read-name-p &rest args)
  (with-unique-names (clauses next)
    `(prog (,clauses)
      ,next
        (push (do-parse-clause ,client ,region *index* ,read-name-p ,@args)
              ,clauses)
        (when (maybe-parse-token :keywords '(:and))
          (go ,next))
        (return (nreverse ,clauses)))))

(prog (#:clauses122) #:next123 (push (do-parse-clause client instance *index* t) #:clauses122) (when (maybe-parse-token :keywords (quote (:and))) (go #:next123)) (return (nreverse #:clauses122)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(f nil
  nil)

Issue: Macro call that should be transformed by F

Input:
(f nil
  nil)

Output: (defmacro F ...)


Instruction:
Generate a defmacro form that transforms code like this:
(special-symbol-progv nil
    (progn))

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

Input:
(special-symbol-progv nil
    (progn))

Output: (defmacro SPECIAL-SYMBOL-PROGV ...)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defmacro* nil
    :key
  nil)

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

Input:
(defmacro* nil
    :key
  nil)

Output: (defmacro DEFMACRO* ...)

(defmacro nil :key
  `(with-yield
     ,nil))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(c-assert (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid))))

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

Input: (c-assert (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid))))

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

(unless *stop* (unless (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid))) (c-break "failed assertion: ~a" (quote (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid)))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(odig nil)

Problem: Macro call that should be transformed by ODIG

Input: (odig nil)

Output: (defmacro ODIG ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(when (first in-decl) (pop in-decl-item))

Issue: Macro call that should be transformed by when

Input: (when (first in-decl) (pop in-decl-item))

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(resolve
  'some-name)

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

Input:
(resolve
  'some-name)

Output: (defmacro RESOLVE ...)

(locally
 (declare)
 (multiple-value-bind (#:assignment155 #:unified-p156)
     (type-unify 'nil 'nil (list))
   (assert #:unified-p156 nil 'simple-type-error :format-control
           "gtypes failed to unify to the actual types:~% ~a~%    against~% ~a"
           :format-arguments (list 'nil (list)))
   (let ()
     (declare (ignorable))
     'some-name)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun/1 getchar () (getc stdin))

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

Input: (defun/1 getchar () (getc stdin))

Output:
(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)))))

(progn (defun getchar nil (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (getc stdin)) (defparameter getchar (vacietis.c:mkptr& (symbol-function (quote getchar)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(def$frame nil :key nil)

Issue: Macro call that should be transformed by DEF$FRAME

Input: (def$frame nil :key nil)

Output: (defmacro DEF$FRAME ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-wrap-attempt () name (define-foreign-type name (make-instance 'foreign-alias :name name :type (ensure-type type "alias of type ~S to ~S" type name))))

Problem: Macro call that should be transformed by with-wrap-attempt

Input: (with-wrap-attempt () name (define-foreign-type name (make-instance 'foreign-alias :name name :type (ensure-type type "alias of type ~S to ~S" type name))))

Output:
(defmacro with-wrap-attempt ((&optional format-control &rest format-args) wrappable-name &body body)
  `(call-with-wrap-attempt ,wrappable-name (lambda () ,@body) ,format-control (list ,@format-args)))

(call-with-wrap-attempt name (lambda nil (define-foreign-type name (make-instance (quote foreign-alias) :name name :type (ensure-type type "alias of type ~S to ~S" type name)))) nil (list))


Instruction:
Generate a defmacro form that transforms code like this:
(define-alias-binding append appending)

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

Input: (define-alias-binding append appending)

Output:
(defmacro define-alias-binding (name referenced-binding-name)
  `(progn (setf (binding ',name) ',referenced-binding-name)
          ',name))

(progn (setf (binding (quote append)) (quote appending)) (quote append))


Instruction:
Generate a defmacro form that transforms code like this:
(define-direct-binding over (var iterable &rest iterator-args) (let ((iterator (gensym "ITERATOR")) (next (gensym "NEXT")) (has-more (gensym "HAS-MORE")) (update (gensym "UPDATE")) (end (gensym "END"))) (values `(with-interleaving (let (,@(lambda-fiddle:extract-lambda-vars (enlist var)) (,iterator (make-iterator ,iterable ,@iterator-args)))) (multiple-value-bind (,next ,has-more ,update ,end) (step-functions ,iterator) (declare (ignore ,update))) (unwind-protect* (funcall ,end))) `(if (funcall ,has-more) (update ,var (funcall ,next)) (end-for)))))

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

Input: (define-direct-binding over (var iterable &rest iterator-args) (let ((iterator (gensym "ITERATOR")) (next (gensym "NEXT")) (has-more (gensym "HAS-MORE")) (update (gensym "UPDATE")) (end (gensym "END"))) (values `(with-interleaving (let (,@(lambda-fiddle:extract-lambda-vars (enlist var)) (,iterator (make-iterator ,iterable ,@iterator-args)))) (multiple-value-bind (,next ,has-more ,update ,end) (step-functions ,iterator) (declare (ignore ,update))) (unwind-protect* (funcall ,end))) `(if (funcall ,has-more) (update ,var (funcall ,next)) (end-for)))))

Output:
(defmacro define-direct-binding (name args &body body)
  (let ((env (or (lambda-fiddle:environment-lambda-var args) (gensym "ENVIRONMENT"))))
    `(progn (setf (binding ',name)
                  (lambda ,(lambda-fiddle:remove-environment-part args)
                    (let ((,env *environment*))
                      (declare (ignorable ,env))
                      ,@body)))
            ',name)))

(progn (setf (binding (quote over)) (lambda (var iterable &rest iterator-args) (let ((#:environment127 *environment*)) (declare (ignorable #:environment127)) (let ((iterator (gensym "ITERATOR")) (next (gensym "NEXT")) (has-more (gensym "HAS-MORE")) (update (gensym "UPDATE")) (end (gensym "END"))) (values (sb-int:quasiquote (with-interleaving (let (#S(sb-impl::comma :expr (lambda-fiddle:extract-lambda-vars (enlist var)) :kind 2) (#S(sb-impl::comma :expr iterator :kind 0) (make-iterator #S(sb-impl::comma :expr iterable :kind 0) #S(sb-impl::comma :expr iterator-args :kind 2))))) (multiple-value-bind (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr has-more :kind 0) #S(sb-impl::comma :expr update :kind 0) #S(sb-impl::comma :expr end :kind 0)) (step-functions #S(sb-impl::comma :expr iterator :kind 0)) (declare (ignore #S(sb-impl::comma :expr update :kind 0)))) (unwind-protect* (funcall #S(sb-impl::comma :expr end :kind 0))))) (sb-int:quasiquote (if (funcall #S(sb-impl::comma :expr has-more :kind 0)) (update #S(sb-impl::comma :expr var :kind 0) (funcall #S(sb-impl::comma :expr next :kind 0))) (end-for)))))))) (quote over))


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

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

Input: (-> nil :key nil)

Output: (defmacro -> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(make-instance* 'class (a b c) (when t (list :x x)))

Issue: Macro call that should be transformed by make-instance*

Input: (make-instance* 'class (a b c) (when t (list :x x)))

Output:
(defmacro make-instance* (class &rest arguments)
  "Convenience macro on top of `make-instance'.

Conveniences:

- First argument can be a (possibly empty) list of shortcut symbols,
  which is automatically converted into a KEYWORD+SYMBOL pairs where
  - KEYWORD is the same as shortcut name, but interned as keyword.
  - And SYMBOL is the same as shortcut.

- The last argument can be an apply argument---arbitrary
  list-producing form, which will be used as the last argument
  to (apply #'make-instance ...) idiom.

Note that using a singular shortcut list of apply argument is an
ambiguous case that will be interpreted in favor of apply argument. To
force either of interpretations, provide shortcuts and apply arguments
explicitly:
(make-instance* 'class (a b c)) ;; BAD
(make-instance* 'class (a b c) nil) ;; GOOD
(make-instance* 'class (when t nil)) ;; BAD
(make-instance* 'class () (when t nil)) ;; GOOD

Otherwise, the behavior is equivalent to `make-instance'.

Examples:

Shortcut args:
\(make-instance* 'class (a b c))
=>
\(make-instance 'class :a a :b b :c c)

Last form converted into `apply' argument:
\(make-instance* 'class :c c :b b (when something (list :a a)))
=>
\(apply #'make-instance 'class :c c :b b (when something (list :a a)))

Shortcut arguments, regular arguments, and form for `apply':
\(make-instance* 'class (b c) :x x (when something (list :a a)))
=>
\(apply #'make-instance 'class :b b :c c :x x (when something (list :a a)))

Form for `apply' (notice the empty shortcuts---these are required for
unambiguous parsing):
\(make-instance* 'class () (when something (list :a a)))
=>
\(apply #'make-instance 'class (when something (list :a a)))

Regular `make-instance'-like use:
\(make-instance* 'class :a a-value :b b-value)
=>
\(make-instance 'class :a a-value :b b-value)"
  (when (and (= 1 (length arguments))
             (listp (first arguments)))
    (style-warn "Body of MAKE-INSTANCE* contains a single list-like form ~a.

If you meant APPLY args, add empty shortcuts list:
(make-instance* 'class () (apply-form))

If you meant shortcut list, add empty APPLY args:
(make-instance* 'class (shortcuts) nil)

Interpreting as APPLY args for now, but this behavior may change in
the future." arguments))
  (let* ((shortcuts-p (and (listp (first arguments))
                           (> (length arguments) 1)))
         (shortcuts (when shortcuts-p
                      (first arguments)))
         (arguments (if shortcuts-p
                        (rest arguments)
                        arguments))
         (last-appendable-form-p (oddp (length arguments)))
         (last-appendable-form (when last-appendable-form-p
                                 (first (last arguments))))
         (arguments (if last-appendable-form-p
                        (butlast arguments)
                        arguments)))
    `(,@(if last-appendable-form-p
            `(apply #'make-instance)
            `(make-instance))
      ,class
      ,@(loop for shortcut in shortcuts
              append (list (intern (symbol-name shortcut) :keyword)
                           shortcut))
      ,@arguments
      ,@(when last-appendable-form-p
          (list last-appendable-form)))))

(apply (function make-instance) (quote class) :a a :b b :c c (when t (list :x x)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-case-aware-find-symbol find-pp-operator-name #:with-c-syntax.preprocess-operator)

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

Input: (define-case-aware-find-symbol find-pp-operator-name #:with-c-syntax.preprocess-operator)

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #A((41) base-char . "WITH-C-SYNTAX.PREPROCESS-OPERATOR.UPCASED") (:use) (:intern #A((7) base-char . "DEFINED") #A((7) base-char . "_PRAGMA"))) (setf (symbol-value (find-symbol #A((7) base-char . "DEFINED") (quote #A((41) base-char . "WITH-C-SYNTAX.PREPROCESS-OPERATOR.UPCASED")))) (quote with-c-syntax.preprocess-operator:|defined|)) (setf (symbol-value (find-symbol #A((7) base-char . "_PRAGMA") (quote #A((41) base-char . "WITH-C-SYNTAX.PREPROCESS-OPERATOR.UPCASED")))) (quote with-c-syntax.preprocess-operator:|_Pragma|)) (defun find-pp-operator-name (string &optional (readtable-case (readtable-case *readtable*))) #A((109) base-char . "Find a symbol in `WITH-C-SYNTAX.PREPROCESS-OPERATOR' package having a same NAME. If not found, returns `nil'.") (ecase readtable-case ((:upcase :invert) (if-let ((up-sym (find-symbol string (quote #A((41) base-char . "WITH-C-SYNTAX.PREPROCESS-OPERATOR.UPCASED"))))) (symbol-value up-sym))) ((:downcase :preserve) (find-symbol string (quote #:with-c-syntax.preprocess-operator))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(*> (string "Mālum") (char #\,))

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

Input: (*> (string "Mālum") (char #\,))

Output:
(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)))))

(lambda (#:*>-offset203) (multiple-value-bind (#:*>-res204 #:*>-next205) (funcall (string "Mālum") #:*>-offset203) (if (ok? #:*>-res204) (funcall (char #\COMMA) #:*>-next205) (fail #:*>-next205))))


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

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

Input: (-<> nil :key nil)

Output: (defmacro -<> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-yield (dolist (x data) (yield x (1+ x))))

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

Input: (with-yield (dolist (x data) (yield x (1+ x))))

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

(let (#:g143 #:g144) (with-call/cc (labels ((yield (&rest values) (setf #:g144 values) (let/cc k (setf #:g143 k)))) (dolist (x data) (yield x (1+ x))) (setf #:g143 nil))) (gen-lambda nil (cond ((null #:g143) (quote generator-stop)) (t (let ((current #:g144)) (funcall #:g143 nil) (apply (function values) (funcall values-handler current)))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(->>
  nil
  (progn))

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

Input:
(->>
  nil
  (progn))

Output: (defmacro ->> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(draw scene (:rect :x 0 :y 0 :height "100%" :width "100%") :fill (xlink-href pattern))

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

Input: (draw scene (:rect :x 0 :y 0 :height "100%" :width "100%") :fill (xlink-href pattern))

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

(let ((#:g154 (funcall (function make-svg-element) :rect (append (list :x 0 :y 0 :height "100%" :width "100%") (list :fill (xlink-href pattern)))))) (add-element scene #:g154) #:g154)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-yield-binds (if *inside-insert-into* (apply #'format nil "(~{~A~^, ~}) VALUES (~{~A~^, ~})" (loop for (k v) on (set=-clause-args clause) by #'cddr collect (yield-arg k) into keys collect (yield-arg v) into values finally (return (list keys values)))) (format nil "SET ~{~A = ~A~^, ~}" (mapcar #'yield-arg (set=-clause-args clause)))))

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

Input: (with-yield-binds (if *inside-insert-into* (apply #'format nil "(~{~A~^, ~}) VALUES (~{~A~^, ~})" (loop for (k v) on (set=-clause-args clause) by #'cddr collect (yield-arg k) into keys collect (yield-arg v) into values finally (return (list keys values)))) (format nil "SET ~{~A = ~A~^, ~}" (mapcar #'yield-arg (set=-clause-args clause)))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (if *inside-insert-into* (apply (function format) nil "(~{~A~^, ~}) VALUES (~{~A~^, ~})" (loop for (k v) on (set=-clause-args clause) by (function cddr) collect (yield-arg k) into keys collect (yield-arg v) into values finally (return (list keys values)))) (format nil "SET ~{~A = ~A~^, ~}" (mapcar (function yield-arg) (set=-clause-args clause))))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defpattern alist (&rest args) `(and ,@(loop for (key . value) in args collect `(assoc ,key ,value))))

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

Input: (defpattern alist (&rest args) `(and ,@(loop for (key . value) in args collect `(assoc ,key ,value))))

Output:
(defmacro defpattern (name lambda-list &body body)
  "Defines a derived pattern specifier named NAME. This is analogous
to DEFTYPE.

Examples:

    ;; Defines a LIST pattern.
    (defpattern list (&rest args)
      (when args
        `(cons ,(car args) (list ,@(cdr args)))))"
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (pattern-expand-function ',name) (lambda ,lambda-list ,@body))))

(%defpattern alist (quote &rest) (quote args) (lambda (quasiquote (and #S(sb-impl::comma :expr (loop for (key . value) in args collect (quasiquote (assoc #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)))) :kind 2)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(mvlet nil
  :key
  nil)

Issue: Macro call that should be transformed by MVLET

Input:
(mvlet nil
  :key
  nil)

Output: (defmacro MVLET ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(cond-> 'some-name)

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

Input: (cond-> 'some-name)

Output: (defmacro COND-> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(xor nil nil nil)

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

Input: (xor nil nil nil)

Output:
(defmacro xor (&rest datums)
  "Evaluates its arguments one at a time, from left to right. If more than one
argument evaluates to a true value no further DATUMS are evaluated, and NIL is
returned as both primary and secondary value. If exactly one argument
evaluates to true, its value is returned as the primary value after all the
arguments have been evaluated, and T is returned as the secondary value. If no
arguments evaluate to true NIL is returned as primary, and T as secondary
value."
  (with-gensyms (xor tmp true)
    `(let (,tmp ,true)
       (declare (ignorable ,tmp))
       (block ,xor
         ,@(mapcar (lambda (datum)
                     `(if (setf ,tmp ,datum)
                          (if ,true
                              (return-from ,xor (values nil nil))
                              (setf ,true ,tmp))))
                   datums)
         (return-from ,xor (values ,true t))))))

(let (#:tmp147 #:true148) (declare (ignorable #:tmp147)) (block #:xor146 (if (setf #:tmp147 nil) (if #:true148 (return-from #:xor146 (values nil nil)) (setf #:true148 #:tmp147))) (if (setf #:tmp147 nil) (if #:true148 (return-from #:xor146 (values nil nil)) (setf #:true148 #:tmp147))) (if (setf #:tmp147 nil) (if #:true148 (return-from #:xor146 (values nil nil)) (setf #:true148 #:tmp147))) (return-from #:xor146 (values #:true148 t))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(deferror "55006" object-in-use object-state-error)

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

Input: (deferror "55006" object-in-use object-state-error)

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

(progn (define-condition object-in-use (object-state-error) nil) (setf (gethash "55006" *error-table*) (quote object-in-use)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(while nil
  (progn))

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

Input:
(while nil
  (progn))

Output: (defmacro WHILE ...)

(loop while nil
      do (progn (progn)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclass/a dbd-mysql (dbi-driver) ())

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

Input: (defclass/a dbd-mysql (dbi-driver) ())

Output:
(defmacro defclass/a (name superclasses slots &rest class-options)
  `(progn
     (defclass ,name ,superclasses ,slots ,@class-options)
     (deftype ,(intern (format nil "<~A>" (symbol-name name))) () ',name)
     (setf (find-class ',(intern (format nil "<~A>" (symbol-name name))))
           (find-class ',name))))

(progn (defclass dbd-mysql (dbi-driver) nil) (deftype <dbd-mysql> nil (quote dbd-mysql)) (setf (find-class (quote <dbd-mysql>)) (find-class (quote dbd-mysql))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-connection (execute (create-table :user ((id :type :bigint :primary-key t) (name :type '(:varchar 32)) (email :type '(:varchar 255)) (status :type '(:varchar 20)) (created_at :type :datetime) (updated_at :type :datetime)))) (execute (create-table :tweet ((id :type :bigint :primary-key t) (user_id :type :bigint) (body :type :text) (created_at :type :datetime)))) (execute (insert-into :user (set= :id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 1 :user_id 1 :body "Hi." :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 2 :user_id 1 :body "Is it working?" :created_at (princ-to-string *now*)))))

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

Input: (with-connection (execute (create-table :user ((id :type :bigint :primary-key t) (name :type '(:varchar 32)) (email :type '(:varchar 255)) (status :type '(:varchar 20)) (created_at :type :datetime) (updated_at :type :datetime)))) (execute (create-table :tweet ((id :type :bigint :primary-key t) (user_id :type :bigint) (body :type :text) (created_at :type :datetime)))) (execute (insert-into :user (set= :id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 1 :user_id 1 :body "Hi." :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 2 :user_id 1 :body "Is it working?" :created_at (princ-to-string *now*)))))

Output:
(defmacro with-connection (&body body)
  `(let ((*connection* (connect-cached :sqlite3 :database-name *db-path*)))
     ,@body))

(let ((execute (connect (create-table :user ((id :type :bigint :primary-key t) (name :type (quote (:varchar 32))) (email :type (quote (:varchar 255))) (status :type (quote (:varchar 20))) (created_at :type :datetime) (updated_at :type :datetime)))))) (unwind-protect (progn (execute (create-table :tweet ((id :type :bigint :primary-key t) (user_id :type :bigint) (body :type :text) (created_at :type :datetime)))) (execute (insert-into :user (set= :id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 1 :user_id 1 :body "Hi." :created_at (princ-to-string *now*)))) (execute (insert-into :tweet (set= :id 2 :user_id 1 :body "Is it working?" :created_at (princ-to-string *now*))))) (disconnect execute)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(gen-lambda-with-sticky-stop () (unless (cdr ldata) (get-next)) (setf ldata (cdr ldata)) (if (eq (car ldata) 'generator-stop) (sticky-stop) (apply #'values (ensure-list (car ldata)))))

Issue: Macro call that should be transformed by gen-lambda

Input: (gen-lambda-with-sticky-stop () (unless (cdr ldata) (get-next)) (setf ldata (cdr ldata)) (if (eq (car ldata) 'generator-stop) (sticky-stop) (apply #'values (ensure-list (car ldata)))))

Output:
(defmacro gen-lambda (params &body rest)
  "Version of lambda that wraps the anonymous function in an instance of the basic-generator class. This allows the lambda to be identified as a generator by its type. Basic-generator objects are derived from funcallable-standard-class, therefore they can be called as functions."
  `(let ((values-handler (create-values-handler)))
     (declare (ignorable values-handler))
     (make-instance
      'basic-generator
      :function (lambda ,params ,@rest))))

(make-instance (quote basic-generator) :function (sticky-stop-lambda nil (unless (cdr ldata) (get-next)) (setf ldata (cdr ldata)) (if (eq (car ldata) (quote generator-stop)) (sticky-stop) (apply (function values) (ensure-list (car ldata))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(let-syntax common-lisp:nil)

Problem: Macro call that should be transformed by LET-SYNTAX

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

Output: (defmacro LET-SYNTAX ...)


Instruction:
Generate a defmacro form that transforms code like this:
(bind (((:struct metabang-bind-test-1- a c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (ensure-same '(4 1 3) (list values a c) :test 'equal))

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

Input: (bind (((:struct metabang-bind-test-1- a c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (ensure-same '(4 1 3) (list values a c) :test 'equal))

Output:
(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))))

(let* ((#:|values-189| (make-metabang-bind-test-1 :a 1 :b 2 :c 3)) (a (metabang-bind-test-1-a #:|values-189|)) (c (metabang-bind-test-1-c #:|values-189|))) (declare (ignorable #:|values-189|)) (progn (ensure-same (quote (4 1 3)) (list values a c) :test (quote equal))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(cond->
  nil
  nil)

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

Input:
(cond->
  nil
  nil)

Output: (defmacro COND-> ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-sequences! ((place seq :start start :end end) (new new)) (setf place new))

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

Input: (do-sequences! ((place seq :start start :end end) (new new)) (setf place new))

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

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

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

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

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

         ,name
         ,seqs
         ,@forms))))

(do-sequences!-fast% nil ((place seq :start start :end end) (new new)) (setf place new))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-documentation-lookup function cl:function)

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

Input: (define-simple-documentation-lookup function cl:function)

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

(defmethod documentation ((function function)) (common-lisp:documentation (designator function) (quote common-lisp:function)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-quote-char (sxql:yield sql))

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

Input: (with-quote-char (sxql:yield sql))

Output:
(defmacro with-quote-char (&body body)
  `(let ((sxql:*quote-character* (or sxql:*quote-character*
                                     (connection-quote-character *connection*))))
     ,@body))

(let ((sxql/sql-type:*quote-character* (or sxql/sql-type:*quote-character* (connection-quote-character *connection*)))) (sxql/sql-type:yield sql))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-component make)

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

Input: (define-component make)

Output:
(defmacro define-component (name &key input-type output-type compile-function)
  "Define an ASDF component."
  `(progn
     (defclass ,name (source-file)
       ((type :initform ,input-type)
        (output :reader output :initarg :output)))

     (defmethod perform ((o load-op) (component ,name)) t)

     (defmethod output-files ((operation compile-op) (component ,name))
       (list
        (output-pathname component ,output-type)))

     (defmethod perform ((o compile-op) (component ,name))
       (funcall ,compile-function
                (component-pathname component)
                (output-pathname component ,output-type)))

     (import ',name :asdf)))

(progn (defclass make (source-file) ((type :initform nil) (output :reader output :initarg :output))) (defmethod perform ((o load-op) (component make)) t) (defmethod output-files ((operation compile-op) (component make)) (list (output-pathname component nil))) (defmethod perform ((o compile-op) (component make)) (funcall nil (component-pathname component) (output-pathname component nil))) (import (quote make) :asdf))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defclause-driver (for var in list &optional by (step ''cdr)) "Elements of a list" (top-level-check) (let* ((on-var (make-var-and-binding 'list list :type 'list)) (setqs (do-dsetq var `(car ,on-var))) (test `(if (endp ,on-var) (go ,*loop-end*)))) (setq *loop-end-used?* t) (return-driver-code :next (list test setqs (generate-function-step-code on-var step)) :variable var)))

Problem: Macro call that should be transformed by defclause

Input: (defclause-driver (for var in list &optional by (step ''cdr)) "Elements of a list" (top-level-check) (let* ((on-var (make-var-and-binding 'list list :type 'list)) (setqs (do-dsetq var `(car ,on-var))) (test `(if (endp ,on-var) (go ,*loop-end*)))) (setq *loop-end-used?* t) (return-driver-code :next (list test setqs (generate-function-step-code on-var step)) :variable var)))

Output:
(defmacro defclause (clause-template &body body)
  (define-clause 'defun clause-template body nil))

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-for-in-5 (&key ((:for var)) ((:in list)) ((:by step) (quote (quote cdr))) generate) "Elements of a list" (top-level-check) (let* ((on-var (make-var-and-binding (quote list) list :type (quote list))) (setqs (do-dsetq var (sb-int:quasiquote (car #S(sb-impl::comma :expr on-var :kind 0))))) (test (sb-int:quasiquote (if (endp #S(sb-impl::comma :expr on-var :kind 0)) (go #S(sb-impl::comma :expr *loop-end* :kind 0)))))) (setq *loop-end-used?* t) (return-driver-code :next (list test setqs (generate-function-step-code on-var step)) :variable var))) (install-clause-info (quote (for :in)) (quote (for :in &optional :by)) (quote clause-for-in-5) "Elements of a list" t) (quote (for var in list &optional by (step (quote (quote cdr))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(make-$instance nil :key nil)

Problem: Macro call that should be transformed by MAKE-$INSTANCE

Input: (make-$instance nil :key nil)

Output: (defmacro MAKE-$INSTANCE ...)

(let ((class (symbol-value nil)))
  (funcall (mcs-slot-value class (index-of-basicnew-fn)) class :key nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-simple-object-lookup class find-class)

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

Input: (define-simple-object-lookup class find-class)

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

(defmethod object ((class class)) (find-class (designator class)))


Instruction:
Generate a defmacro form that transforms code like this:
(f_
  nil
  :key
  nil)

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

Input:
(f_
  nil
  :key
  nil)

Output: (defmacro F_ ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(eswitch (x :test =) (12 :oops) (13.0 :yay))

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

Input: (eswitch (x :test =) (12 :oops) (13.0 :yay))

Output:
(defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
                          &body clauses)
  "Like SWITCH, but signals an error if no key matches."
  (generate-switch-body whole object clauses test key '(error)))

(let ((#:value132 (identity x))) (cond ((= #:value132 12) :oops) ((= #:value132 13.0) :yay) (t (error "No keys match in SWITCH. Testing against ~S with ~S." #:value132 (quote =)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite caaar (expr) `(car (caar ,(second expr))))

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

Input: (define-modf-rewrite caaar (expr) `(car (caar ,(second expr))))

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-neo4j-fun set-relationship-property (relationship-id property value) :put (:uri-spec (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:encode value :string) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'relationship-not-found-error :uri uri))))

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

Input: (def-neo4j-fun set-relationship-property (relationship-id property value) :put (:uri-spec (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:encode value :string) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'relationship-not-found-error :uri uri))))

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

(progn (defun set-relationship-property (&key relationship-id property value) (let ((uri (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (json (encode-neo4j-json-payload value :string))) (make-neo4j-request :put uri json (list (list 204 (lambda (body uri json) (values t body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote relationship-not-found-error) :uri uri))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(iterate nil (progn))

Issue: Macro call that should be transformed by ITERATE

Input: (iterate nil (progn))

Output: (defmacro ITERATE ...)

(progn (tagbody #:ll-252 ((lambda () (progn))) (go #:ll-252)) nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do+ (for y (to x)) (collect y) (when (= x y) (update x)))

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

Input: (do+ (for y (to x)) (collect y) (when (= x y) (update x)))

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

(do+/internal nil (for y (to x)) (collect y) (when (= x y) (update x)))


Instruction:
Generate a defmacro form that transforms code like this:
(enable-infix-reader)

Pattern to recognize: Macro call that should be transformed by ENABLE-INFIX-READER

Input: (enable-infix-reader)

Output: (defmacro ENABLE-INFIX-READER ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (push *readtable* *readtables*)
  (setq *readtable* (copy-readtable))
  (set-macro-character #\LEFT_CURLY_BRACKET #'infix-reader nil)
  (set-macro-character #\RIGHT_CURLY_BRACKET #'infix-end nil))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(bind ((instance (make-instance 'metabang-bind-class-1 :a 1 :b 2 :c 3)) ((:slots a (my-c c) (the-b b)) instance)) (setf a :changed) (list (slot-value instance 'a) the-b my-c))

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

Input: (bind ((instance (make-instance 'metabang-bind-class-1 :a 1 :b 2 :c 3)) ((:slots a (my-c c) (the-b b)) instance)) (setf a :changed) (list (slot-value instance 'a) the-b my-c))

Output:
(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))))

(let* ((instance (make-instance (quote metabang-bind-class-1) :a 1 :b 2 :c 3)) (#:|values-171| instance)) (declare (ignorable #:|values-171|)) (with-slots ((a a) (my-c c) (the-b b)) #:|values-171| (progn (setf a :changed) (list (slot-value instance (quote a)) the-b my-c))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(collect nil)

Issue: Macro call that should be transformed by COLLECT

Input: (collect nil)

Output: (defmacro COLLECT ...)

(common-lisp:let* ((#:generator-581 (generator nil))
                   #:items-576
                   (#:lastcons-577 (list nil))
                   (#:lst-578 #:lastcons-577))
  (declare (type generator #:generator-581)
           (type cons #:lastcons-577)
           (type list #:lst-578))
  (tagbody
   #:ll-582
    (setq #:items-576 (next-in #:generator-581 (go end)))
    (setq #:lastcons-577 (setf (cdr #:lastcons-577) (cons #:items-576 nil)))
    (go #:ll-582)
   end)
  (cdr #:lst-578))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when initializer `(make-nodelist ,initializer))

Problem: Macro call that should be transformed by when

Input: (when initializer `(make-nodelist ,initializer))

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

(if initializer (sb-int:quasiquote (make-nodelist #S(sb-impl::comma :expr initializer :kind 0))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-env [struct 'a])

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

Input: (with-env [struct 'a])

Output:
(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))

(let (#:g132) (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 #:g132 (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)) [struct (quote a]))) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g132)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-let node) (multiple-value-bind (new-node new-changed?) (maybe-collapse-alias-let node) (when new-changed? (setf changed? t) new-node)))

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

Input: (action (:after node-let node) (multiple-value-bind (new-node new-changed?) (maybe-collapse-alias-let node) (when new-changed? (setf changed? t) new-node)))

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

(make-action (quote :after) (quote node-let) (lambda (node) (declare (type node-let node)) (multiple-value-bind (new-node new-changed?) (maybe-collapse-alias-let node) (when new-changed? (setf changed? t) new-node))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(swhen x (setf it :ok))

Problem: Macro call that should be transformed by swhen

Input: (swhen x (setf it :ok))

Output:
(defmacro swhen (test &body body)
  "Like WHEN, except binds the test form to IT (via SYMBOL-MACROLET) for the
scope of the body. IT can be set with SETF."
  `(symbolic when ,test ,@body))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lambda+ 'some-name)

Problem: Macro call that should be transformed by LAMBDA+

Input: (lambda+ 'some-name)

Output: (defmacro LAMBDA+ ...)


Instruction:
Generate a defmacro form that transforms code like this:
(def-iter iterator-product (item-vec indices lengths stopped) (product (&rest iterables) "Cartesian product of input iterables, returned as vectors in lexicographic order. Due to the awkwardness in mixing `&rest` and `&key` parameters in lambda lists, this function does not implement the `repeat` argument supported in [Python's version](https://docs.python.org/3/library/itertools.html#itertools.product). Use `picl:nfold-product` instead. ``` (product '(1 2) '(3 4)) ;; #(1 3), #(1 4), #(2 3), #(2 4) ```" (loop with item-vec = (make-array (length iterables)) with lengths = (make-array (length iterables)) for i below (length item-vec) for iter in iterables do (setf (aref item-vec i) (iter-to-vec iter)) (setf (aref lengths i) (length (aref item-vec i))) minimizing (aref lengths i) into min-len finally (return (if (zerop min-len) (empty-iterator) (init-state item-vec lengths (indices (make-array (length item-vec) :initial-element 0))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array (length indices)) for i below (length indices) for ii = (aref indices i) do (setf (aref product i) (aref (aref item-vec i) ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) (aref lengths i)) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- (length indices)))))))

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

Input: (def-iter iterator-product (item-vec indices lengths stopped) (product (&rest iterables) "Cartesian product of input iterables, returned as vectors in lexicographic order. Due to the awkwardness in mixing `&rest` and `&key` parameters in lambda lists, this function does not implement the `repeat` argument supported in [Python's version](https://docs.python.org/3/library/itertools.html#itertools.product). Use `picl:nfold-product` instead. ``` (product '(1 2) '(3 4)) ;; #(1 3), #(1 4), #(2 3), #(2 4) ```" (loop with item-vec = (make-array (length iterables)) with lengths = (make-array (length iterables)) for i below (length item-vec) for iter in iterables do (setf (aref item-vec i) (iter-to-vec iter)) (setf (aref lengths i) (length (aref item-vec i))) minimizing (aref lengths i) into min-len finally (return (if (zerop min-len) (empty-iterator) (init-state item-vec lengths (indices (make-array (length item-vec) :initial-element 0))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array (length indices)) for i below (length indices) for ii = (aref indices i) do (setf (aref product i) (aref (aref item-vec i) ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) (aref lengths i)) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- (length indices)))))))

Output:
(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))))))

(labels ((#:next-fname125 (&key item-vec indices lengths stopped) (labels ((self nil (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array (length indices)) for i below (length indices) for ii = (aref indices i) do (setf (aref product i) (aref (aref item-vec i) ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) (aref lengths i)) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- (length indices)))))))) (function self)))) (defun product (&rest iterables) "Cartesian product of input iterables, returned as vectors in lexicographic order. Due to the awkwardness in mixing `&rest` and `&key` parameters in lambda lists, this function does not implement the `repeat` argument supported in [Python's version](https://docs.python.org/3/library/itertools.html#itertools.product). Use `picl:nfold-product` instead. ``` (product '(1 2) '(3 4)) ;; #(1 3), #(1 4), #(2 3), #(2 4) ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname125)) (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))))) (loop with item-vec = (make-array (length iterables)) with lengths = (make-array (length iterables)) for i below (length item-vec) for iter in iterables do (setf (aref item-vec i) (iter-to-vec iter)) (setf (aref lengths i) (length (aref item-vec i))) minimizing (aref lengths i) into min-len finally (return (if (zerop min-len) (empty-iterator) (init-state item-vec lengths (indices (make-array (length item-vec) :initial-element 0)))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(augment final-code final)

Issue: Macro call that should be transformed by augment

Input: (augment final-code final)

Output:
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))

(setf final-code (nconc final-code final))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-simple-definition-resolver type-definition (designator) (eql :defined (sb-int:info :type :kind designator)))

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

Input: (define-simple-definition-resolver type-definition (designator) (eql :defined (sb-int:info :type :kind designator)))

Output:
(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))))))

(define-definition-resolver type-definition (type-definition #:package144) (when (ignore-errors (let ((designator type-definition)) (eql :defined (sb-int:info :type :kind designator)))) (list (make-instance (quote type-definition) :designator type-definition :package #:package144))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> +tag-start+ +peek-no-slash+)

Issue: Macro call that should be transformed by *>

Input: (*> +tag-start+ +peek-no-slash+)

Output:
(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)))))

(lambda (#:*>-offset262) (multiple-value-bind (#:*>-res263 #:*>-next264) (funcall +tag-start+ #:*>-offset262) (if (ok? #:*>-res263) (funcall +peek-no-slash+ #:*>-next264) (fail #:*>-next264))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(collect-append 'some-name)

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

Input: (collect-append 'some-name)

Output: (defmacro COLLECT-APPEND ...)

(common-lisp:let* ((#:generator-230 (generator 'some-name))
                   #:items-225
                   (#:lst-226 nil)
                   (#:list-227 nil))
  (declare (type generator #:generator-230)
           (type list #:lst-226)
           (type list #:list-227))
  (tagbody
   #:ll-231
    (setq #:items-225 (next-in #:generator-230 (go end)))
    (when #:items-225
      (common-lisp:multiple-value-bind (copy lastcons)
          (copy-list-last #:items-225)
        (when #:list-227 (rplacd #:list-227 copy))
        (setq #:list-227 lastcons)
        (when (null #:lst-226) (setq #:lst-226 copy))))
    (go #:ll-231)
   end)
  #:lst-226)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(alist-bind (name id fields) form (let ((sym (foreign-type-symbol name :cenum *package*))) (when (symbol-package sym) (pushnew sym *foreign-other-exports-list*)) `(progn ,@(parse-enum-to-const fields) (define-foreign-enum ',sym ,id ',(parse-enum-fields fields)))))

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

Input: (alist-bind (name id fields) form (let ((sym (foreign-type-symbol name :cenum *package*))) (when (symbol-package sym) (pushnew sym *foreign-other-exports-list*)) `(progn ,@(parse-enum-to-const fields) (define-foreign-enum ',sym ,id ',(parse-enum-fields fields)))))

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

(let ((#:alist243 form)) (let ((name (aval :name #:alist243)) (id (aval :id #:alist243)) (fields (aval :fields #:alist243))) (let ((sym (foreign-type-symbol name :cenum *package*))) (when (symbol-package sym) (pushnew sym *foreign-other-exports-list*)) (sb-int:quasiquote (progn #S(sb-impl::comma :expr (parse-enum-to-const fields) :kind 2) (define-foreign-enum (quote #S(sb-impl::comma :expr sym :kind 0)) #S(sb-impl::comma :expr id :kind 0) (quote #S(sb-impl::comma :expr (parse-enum-fields fields) :kind 0))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(ltbdd-with-new-hash nil
  nil)

Issue: Macro call that should be transformed by LTBDD-WITH-NEW-HASH

Input:
(ltbdd-with-new-hash nil
  nil)

Output: (defmacro LTBDD-WITH-NEW-HASH ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(atomically nil () (decf counter))

Problem: Macro call that should be transformed by atomically

Input: (atomically nil () (decf counter))

Output:
(defmacro atomically (invariant &body args)
  "Encloses atomic flow block of code that can be dispatched
concurrently. Non-consing."
  (destructuring-bind (opts lambda-list body) (parse-atomic-block-args args)
    (flow-lambda-macro (flow-context)
      (with-flow-function-macro (body-fu lambda-list body)
        `(dispatch-atomically ,flow-context #',body-fu ,invariant ,@opts)))))

(%flow-lambda (#:flow-context153) (%with-flow-function (#:body-fu154 nil (decf counter)) (dispatch-atomically #:flow-context153 (function #:body-fu154) nil)))