Instruction:
Generate a defmacro form that transforms code like this:
(with-table node hash depth (bitmap array bits index hit) (if (not hit) node (let ((new-node (%hamt-remove (aref array index) key hash (1+ depth) test))) (cond (new-node (make-instance (type-of node) :bitmap bitmap :table (vec-update array index new-node))) ((= bitmap 1) nil) (t (make-instance (type-of node) :bitmap (logxor bitmap (ash 1 bits)) :table (vec-remove array index)))))))

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

Input: (with-table node hash depth (bitmap array bits index hit) (if (not hit) node (let ((new-node (%hamt-remove (aref array index) key hash (1+ depth) test))) (cond (new-node (make-instance (type-of node) :bitmap bitmap :table (vec-update array index new-node))) ((= bitmap 1) nil) (t (make-instance (type-of node) :bitmap (logxor bitmap (ash 1 bits)) :table (vec-remove array index)))))))

Output:
(defmacro with-table (node hash depth
                      (bitmap array bits index hit)
                      &body body)
  "Bitshifting in HAMT tables"
  `(let* ((,bitmap (table-bitmap ,node))
          (,array (table-array ,node))
          (,bits (get-bits ,hash ,depth))
          (,index (get-index ,bits ,bitmap))
          (,hit (logbitp ,bits ,bitmap)))
     ,@body))

(let* ((bitmap (table-bitmap node)) (array (table-array node)) (bits (get-bits hash depth)) (index (get-index bits bitmap)) (hit (logbitp bits bitmap))) (if (not hit) node (let ((new-node (%hamt-remove (aref array index) key hash (1+ depth) test))) (cond (new-node (make-instance (type-of node) :bitmap bitmap :table (vec-update array index new-node))) ((= bitmap 1) nil) (t (make-instance (type-of node) :bitmap (logxor bitmap (ash 1 bits)) :table (vec-remove array index)))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-package (package (or identifier *package*)) (cond ((not package) (error 'module-not-found :requested identifier)) (T (or (resolve-module package) (error 'not-a-module :requested package)))))

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

Input: (with-package (package (or identifier *package*)) (cond ((not package) (error 'module-not-found :requested identifier)) (T (or (resolve-module package) (error 'not-a-module :requested package)))))

Output:
(defmacro with-package ((var &optional (package var)) &body body)
  `(let ((,var (ensure-package ,package)))
     ,@body))

(let ((package (ensure-package (or identifier *package*)))) (cond ((not package) (error (quote module-not-found) :requested identifier)) (t (or (resolve-module package) (error (quote not-a-module) :requested package)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(%proper-list-p var 'cons)

What needs to change: Macro call that should be transformed by %proper-list-p

Input: (%proper-list-p var 'cons)

Output:
(defmacro %proper-list-p (var &optional (element-type '*))
  `(loop
     (typecase ,var
       (null (return t))
       (cons (if (or ,(eq element-type '*)
                     (typep (car ,var) ,element-type))
                 (setq ,var (cdr ,var))
                 (return)))
       (t    (return)))))

(loop (typecase var (null (return t)) (cons (if (or nil (typep (car var) (quote cons))) (setq var (cdr var)) (return))) (t (return))))


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

Problem: Macro call that should be transformed by DEFACTION

Input:
(defaction nil
    (progn))

Output: (defmacro DEFACTION ...)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(deferror "23" integrity-violation)

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

Input: (deferror "23" 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 integrity-violation (database-error) nil) (setf (gethash "23" *error-table*) (quote integrity-violation)))


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

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

Input:
(ct-let nil
  nil)

Output: (defmacro CT-LET ...)

(cond
 (*within-captured-dynenv*
  (let ()
    (let ((#:new-var-space151
           (reduce
            (lambda (#:accum152 #:item153)
              (destructuring-bind
                  (#:name154 . #:value155)
                  #:item153
                (update-alist #:name154 #:value155 #:accum152)))
            (list) :initial-value *var-space*)))
      `(symbol-macrolet ((var-space ,#:new-var-space151))
         ,(let ((*var-space* #:new-var-space151))
            nil)))))
 (t
  (error
   "No macrodynamic environment has been captured to establish CT-LET bindings.")))


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

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

Input:
(f_
  'some-name)

Output: (defmacro F_ ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(some-> nil)

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

Input: (some-> nil)

Output: (defmacro SOME-> ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(alist-bind (name inline parameters return-type variadic) form (unless inline (let ((sym (foreign-type-symbol name :cfun *package*))) (let ((cfun-fields (parse-fields parameters :cparam))) (push sym *foreign-function-list*) `(define-foreign-function '(,sym ,name ,@(when variadic '(:variadic-p t))) ',@(parse-type return-type (aval :tag return-type)) ',cfun-fields)))))

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

Input: (alist-bind (name inline parameters return-type variadic) form (unless inline (let ((sym (foreign-type-symbol name :cfun *package*))) (let ((cfun-fields (parse-fields parameters :cparam))) (push sym *foreign-function-list*) `(define-foreign-function '(,sym ,name ,@(when variadic '(:variadic-p t))) ',@(parse-type return-type (aval :tag return-type)) ',cfun-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 ((#:alist244 form)) (let ((name (aval :name #:alist244)) (inline (aval :inline #:alist244)) (parameters (aval :parameters #:alist244)) (return-type (aval :return-type #:alist244)) (variadic (aval :variadic #:alist244))) (unless inline (let ((sym (foreign-type-symbol name :cfun *package*))) (let ((cfun-fields (parse-fields parameters :cparam))) (push sym *foreign-function-list*) (sb-int:quasiquote (define-foreign-function (quote (#S(sb-impl::comma :expr sym :kind 0) #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr (when variadic (quote (:variadic-p t))) :kind 2))) (quote #S(sb-impl::comma :expr (parse-type return-type (aval :tag return-type)) :kind 2)) (quote #S(sb-impl::comma :expr cfun-fields :kind 0)))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite cadr (expr) `(car (cdr ,(second expr))))

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

Input: (define-modf-rewrite cadr (expr) `(car (cdr ,(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 cadr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (car (cdr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(sor (elt-like 0 cell) (setf it 1))

Issue: Macro call that should be transformed by sor

Input: (sor (elt-like 0 cell) (setf it 1))

Output:
(defmacro sor (first &rest rest)
  "Like OR, except binds the first argument to IT (via SYMBOL-MACROLET) for
the scope of the rest of the arguments. IT can be set with SETF."
  `(symbolic or ,first ,@rest))

(symbolic or (elt-like 0 cell) (setf it 1))


Instruction:
Define a macro that eliminates this repetitive pattern:
(augment *special-clause-alist* (list (cons symbol doc-string)))

Issue: Macro call that should be transformed by augment

Input: (augment *special-clause-alist* (list (cons symbol doc-string)))

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

(setf *special-clause-alist* (nconc *special-clause-alist* (list (cons symbol doc-string))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(js-inline nil nil)

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

Input: (js-inline nil nil)

Output: (defmacro JS-INLINE ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
($unset "k" "l")

Problem: Macro call that should be transformed by $

Input: ($unset "k" "l")

Output:
(defmacro $ (&rest args)
  `(kv ,@args))

(kv "$unset" (construct-container* 1 (unwrap ($exp+ "k" "l"))))


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

Problem: Macro call that should be transformed by WHILE

Input: (while nil)

Output: (defmacro WHILE ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(signal-reader-error "Expected } after hex code")

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

Input: (signal-reader-error "Expected } after hex code")

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

(error (quote simple-reader-error) :stream *stream* :format-control "Expected } after hex code" :format-arguments (list))


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

Issue: Macro call that should be transformed by LAMBDA+

Input:
(lambda+ nil
  nil)

Output: (defmacro LAMBDA+ ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(augment *finalp* finalp)

Issue: Macro call that should be transformed by augment

Input: (augment *finalp* finalp)

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


Instruction:
Generate a defmacro form that transforms code like this:
(signal-syntax-error* (lexer-pos lexer) "Expected end of string.")

Pattern to recognize: Macro call that should be transformed by signal-syntax-error*

Input: (signal-syntax-error* (lexer-pos lexer) "Expected end of string.")

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

(error (quote ppcre-syntax-error) :pos (lexer-pos lexer) :format-control "Expected end of string." :format-arguments (list))


Instruction:
Generate a defmacro form that transforms code like this:
(define-custom-var (:string-char *string-char-handler*))

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

Input: (define-custom-var (:string-char *string-char-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 (*string-char-handler* . :string-char)) *custom-vars* :test (function equal)) (defvar *string-char-handler*)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(doseq (elem sequence :from-end from-end :start start :end end) (when (funcall test (funcall key elem)) (return (compute-pos pos))) (incf pos))

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

Input: (doseq (elem sequence :from-end from-end :start start :end end) (when (funcall test (funcall key elem)) (return (compute-pos pos))) (incf pos))

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

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

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

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

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

   NAME is the block name, NIL if not given.

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

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

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

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

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

(do-sequences nil ((elem sequence :from-end from-end :start start :end end)) (when (funcall test (funcall key elem)) (return (compute-pos pos))) (incf pos))


Instruction:
Generate a defmacro form that transforms code like this:
(define-custom-var (:array-member *array-member-handler*) (constantly t) "Designator for a function of 1 arbitrary argument (decoded member of Array).")

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

Input: (define-custom-var (:array-member *array-member-handler*) (constantly t) "Designator for a function of 1 arbitrary argument (decoded member of Array).")

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 (*array-member-handler* . :array-member)) *custom-vars* :test (function equal)) (defvar *array-member-handler* (constantly t) "Designator for a function of 1 arbitrary argument (decoded member of Array).")))


Instruction:
Generate a defmacro form that transforms code like this:
(define-cruft %find-readtable (name) "Return the readtable named NAME." #+ :allegro (excl:named-readtable (readtable-name-for-allegro name) nil) #+ :common-lisp (values (gethash name *named-readtables* nil)))

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

Input: (define-cruft %find-readtable (name) "Return the readtable named NAME." #+ :allegro (excl:named-readtable (readtable-name-for-allegro name) nil) #+ :common-lisp (values (gethash name *named-readtables* nil)))

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 %find-readtable)) (defun %find-readtable (name) "Return the readtable named NAME." (values (gethash name *named-readtables* nil))))


Instruction:
Generate a defmacro form that transforms code like this:
(mapcar 'binding-to-symbol bindings)

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

Input: (mapcar 'binding-to-symbol bindings)

Output:
(defmacro m (form &environment *env*)
  (e form))

(mapcar (quote binding-to-symbol) bindings)


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

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

Input: (doseq 'some-name)

Output:
(defmacro doseq ((var seq-form &optional result-form) &body body)
  "doseq iterates over the elements of an sequence and binds value-var to successive values
and then evaluates body as a tagbody that can include declarations. Finally the result-form
is returned after the iteration completes."
  #+clisp
    `(ext:doseq (,var ,seq-form ,result-form)
       ,@body)
  #+sbcl
    `(sb-sequence:dosequence (,var ,seq-form ,result-form)
       ,@body)
  #-(or clisp sbcl)
    `(doseq* (,(gensym) ,var ,seq-form ,result-form)
       ,@body))

(sb-sequence:dosequence (quote some-name nil))


Instruction:
Generate a defmacro form that transforms code like this:
(with-env (setp 4 [arr 0 2]))

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

Input: (with-env (setp 4 [arr 0 2]))

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 (#:g133) (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 #:g133 (let ((str (alexandria:copy-array "abcde")) (vec (alexandria:copy-array #(a b c d e))) (arr (alexandria:copy-array #2A((1 2 3) (4 5 6)))) (list (copy-list (quote (a b c d e)))) (ht (eval (read-from-string "{'a 'b 'c 'd}"))) (ht-eq (eval (read-from-string "{eq \"a\" 1
                                                    \"b\" 2}"))) (ht-equalp (eval (read-from-string "{equalp '(1 2 3) \"a\"
                                                               '(4 5 6) \"b\"}"))) (assoc-list (copy-tree (quote ((a . 1) (b . 2))))) (plist (copy-list (quote (:a 4 :c 5)))) (clos-object (make-instance (quote foo))) (struct (make-bar :a 3))) (declare (ignorable str vec arr list ht ht-eq ht-equalp assoc-list plist clos-object struct)) (setp 4 [arr 0 2]))) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g133)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defmacro/ps nil
    nil)

Problem: Macro call that should be transformed by DEFMACRO/PS

Input:
(defmacro/ps nil
    nil)

Output: (defmacro DEFMACRO/PS ...)

(progn (defmacro nil ()) (import-macros-from-lisp 'nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
(action (:after node-direct-application) #'validate-candidate)

Issue: Macro call that should be transformed by action

Input: (action (:after node-direct-application) #'validate-candidate)

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-direct-application) (function validate-candidate))


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

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

Input:
(flet* nil
  (progn))

Output: (defmacro FLET* ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(max-of nil
  :key
  nil)

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

Input:
(max-of nil
  :key
  nil)

Output: (defmacro MAX-OF ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(bind (((:accessors-r/o (my-a a) (my-c c) (d the-d)) (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5))) (list d my-c my-a))

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

Input: (bind (((:accessors-r/o (my-a a) (my-c c) (d the-d)) (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5))) (list d my-c my-a))

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-175| (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (my-a (a #:|values-175|)) (my-c (c #:|values-175|)) (d (the-d #:|values-175|))) (declare (ignorable #:|values-175|)) (progn (list d my-c my-a)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(signal-reader-error "No character for char-code #x~X" number)

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

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(ct-let nil
  (progn))

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

Input:
(ct-let nil
  (progn))

Output: (defmacro CT-LET ...)

(cond
 (*within-captured-dynenv*
  (let ()
    (let ((#:new-var-space156
           (reduce
            (lambda (#:accum157 #:item158)
              (destructuring-bind
                  (#:name159 . #:value160)
                  #:item158
                (update-alist #:name159 #:value160 #:accum157)))
            (list) :initial-value *var-space*)))
      `(symbol-macrolet ((var-space ,#:new-var-space156))
         ,(let ((*var-space* #:new-var-space156))
            (progn))))))
 (t
  (error
   "No macrodynamic environment has been captured to establish CT-LET bindings.")))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defannotation optimize* (quality) (:alias optimize :inline t) "Shorthand for (DECLARE (OPTIMIZE ...))." `(declare (optimize ,quality)))

Problem: Macro call that should be transformed by defannotation

Input: (defannotation optimize* (quality) (:alias optimize :inline t) "Shorthand for (DECLARE (OPTIMIZE ...))." `(declare (optimize ,quality)))

Output:
(defmacro defannotation (name lambda-list options &body body)
  `(progn
     (set-annotation-options ',name ',options)
     (defmacro ,name ,lambda-list ,@body)))

(progn (set-annotation-options (quote optimize*) (quote (:alias optimize :inline t))) (defmacro optimize* (quality) "Shorthand for (DECLARE (OPTIMIZE ...))." (sb-int:quasiquote (declare (optimize #S(sb-impl::comma :expr quality :kind 0))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-op (:distinct unary-splicing-op))

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

Input: (define-op (:distinct unary-splicing-op))

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

(defstruct (distinct-op (:include unary-splicing-op (name "DISTINCT")) (:constructor make-distinct-op (var))))


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

Issue: Macro call that should be transformed by DRELET

Input: (drelet 'some-name)

Output: (defmacro DRELET ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(sum x :to total)

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

Input: (sum x :to total)

Output:
(defmacro sum (value &key (to (error "sum requires a target accumulator (:to key)")))
  "Syntactic sugar for collect, intended to be used when the accumulator computes a sum."
  `(collect ,value :into ,to))


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

Problem: Macro call that should be transformed by Λ

Input: (λ)

Output: (defmacro Λ ...)


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator (g generator) (when (funcall predicate g) (yield g)))

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

Input: (do-generator (g generator) (when (funcall predicate g) (yield g)))

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

(let ((#:g163 generator)) (loop do (if-generator ((g) #:g163) (progn (when (funcall predicate g) (yield g))) (return))))


Instruction:
Generate a defmacro form that transforms code like this:
(defpattern plist (&rest args) `(and ,@(loop for (key . value) in (plist-alist args) collect `(property ,key ,value))))

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

Input: (defpattern plist (&rest args) `(and ,@(loop for (key . value) in (plist-alist args) collect `(property ,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 plist (quote &rest) (quote args) (lambda (quasiquote (and #S(sb-impl::comma :expr (loop for (key . value) in (plist-alist args) collect (quasiquote (property #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)))) :kind 2)))))


Instruction:
Generate a defmacro form that transforms code like this:
(defun/1 tmpnam (str) (let ((newname (string-to-char* (symbol-name (gensym))))) (if (eql str NULL) newname (progn (replace str newname :end1 (length newname)) str))))

Pattern to recognize: Macro call that should be transformed by defun/1

Input: (defun/1 tmpnam (str) (let ((newname (string-to-char* (symbol-name (gensym))))) (if (eql str NULL) newname (progn (replace str newname :end1 (length newname)) str))))

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 tmpnam (str) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (let ((newname (string-to-char* (symbol-name (gensym))))) (if (eql str null) newname (progn (replace str newname :end1 (length newname)) str)))) (defparameter tmpnam (vacietis.c:mkptr& (symbol-function (quote tmpnam)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(when (eql (top-sign) 'skip-first-attribute) (pop-sign))

Issue: Macro call that should be transformed by when

Input: (when (eql (top-sign) 'skip-first-attribute) (pop-sign))

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

(if (eql (top-sign) (quote skip-first-attribute)) (pop-sign))


Instruction:
Define a macro that eliminates this repetitive pattern:
(lambda-ignoring-_ (dspecs inits _t) (finalize-decl-specs dspecs) `(,dspecs ,(mapcar (lambda (i) (finalize-init-declarator dspecs i)) inits)))

Issue: Macro call that should be transformed by lambda-ignoring-_

Input: (lambda-ignoring-_ (dspecs inits _t) (finalize-decl-specs dspecs) `(,dspecs ,(mapcar (lambda (i) (finalize-init-declarator dspecs i)) inits)))

Output:
(defmacro lambda-ignoring-_ (lambda-list &body body)
  "Works like `cl:lambda' macro except automatically `declare's
 `ignore' for parameters beginning with '_' character."
  (let ((ignored-parameters
          (collect-_-symbol-in-lambda-list lambda-list)))
    (unless ignored-parameters
      (warn "No ignored parameters in: ~A" lambda-list))
    (multiple-value-bind (body decls doc)
        (parse-body body :documentation t)
      `(lambda ,lambda-list
         ,@ (if doc `(,doc))
         (declare (ignore ,@ignored-parameters))
         ,@decls
         ,@body))))

(lambda (dspecs inits _t) (declare (ignore _t)) (finalize-decl-specs dspecs) (sb-int:quasiquote (#S(sb-impl::comma :expr dspecs :kind 0) #S(sb-impl::comma :expr (mapcar (lambda (i) (finalize-init-declarator dspecs i)) inits) :kind 0))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax 'some-name)

Write a macro that addresses: Macro call that should be transformed by ENABLE-QUASI-QUOTED-BIVALENT-TO-BIVALENT-EMITTING-FORM-SYNTAX

Input: (enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax 'some-name)

Output: (defmacro ENABLE-QUASI-QUOTED-BIVALENT-TO-BIVALENT-EMITTING-FORM-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax-in-readtable
   'some-name :with-inline-emitting nil :declarations 'nil :start-character nil
   :end-character nil :unquote-character #\COMMA :splice-character
   #\COMMERCIAL_AT :destructive-splice-character #\FULL_STOP
   :dispatched-quasi-quote-name "biv")
  (values))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause until (condition) "Specifies a termination clause for the loop. When, at the beginning of an iteration, the clause evaluates to true, the loop stops." (make-termination :condition condition))

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

Input: (defclause until (condition) "Specifies a termination clause for the loop. When, at the beginning of an iteration, the clause evaluates to true, the loop stops." (make-termination :condition condition))

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

(progn (defmacro until (condition) "Specifies a termination clause for the loop. When, at the beginning of an iteration, the clause evaluates to true, the loop stops." (make-termination :condition condition)) (pushnew (quote until) *clauses*))


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

Problem: Macro call that should be transformed by FGATHERING

Input:
(fgathering nil
  nil)

Output: (defmacro FGATHERING ...)


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

Issue: Macro call that should be transformed by DEFMETHOD*

Input: (defmethod* nil :key nil)

Output: (defmacro DEFMETHOD* ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(acond ((= 1 2) :no) (nil :nono) (t :yes))

Problem: Macro call that should be transformed by acond

Input: (acond ((= 1 2) :no) (nil :nono) (t :yes))

Output:
(defmacro acond (&body clauses)
  "Like COND, except result of each test-form is bound to IT (via LET) for the
scope of the corresponding clause."
  (labels ((rec (clauses)
	     (if clauses
		 (destructuring-bind ((test &body body) . rest)  clauses
		   (if body
		       `(anaphoric if ,test (progn ,@body) ,(rec rest))
		       `(anaphoric if ,test it ,(rec rest))))
		 nil)))
    (rec clauses)))

(let ((#:it (= 1 2))) (if #:it (let ((it #:it)) (declare (ignorable it)) :no) (acond (nil :nono) (t :yes))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-accumulation-binding maximizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,var) var) ,(if key `(funcall ,key ,result) result))) (setf ,var ,result)))))

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

Input: (define-accumulation-binding maximizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,var) var) ,(if key `(funcall ,key ,result) result))) (setf ,var ,result)))))

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

(define-form-binding maximizing (var form &key key) (values (progn (let ((result (gensym "RESULT"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr result :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when (or (not #S(sb-impl::comma :expr var :kind 0)) (< #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr var :kind 0))) var) :kind 0) #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr result :kind 0))) result) :kind 0))) (setf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr result :kind 0))))))) (delist var)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(symbol-value-in-$instance nil nil)

Problem: Macro call that should be transformed by SYMBOL-VALUE-IN-$INSTANCE

Input: (symbol-value-in-$instance nil nil)

Output: (defmacro SYMBOL-VALUE-IN-$INSTANCE ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-modf-rewrite caaadr (expr) `(car (caadr ,(second expr))))

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

Input: (define-modf-rewrite caaadr (expr) `(car (caadr ,(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 caaadr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (car (caadr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defobject nil)

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

Input: (defobject nil)

Output: (defmacro DEFOBJECT ...)

(object :parents (list) :properties (list))


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

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

Input: (collect-plist nil nil)

Output: (defmacro COLLECT-PLIST ...)

(common-lisp:let* ((#:generator-190 (generator nil))
                   #:values-183
                   (#:generator-188 (generator nil))
                   #:indicators-182
                   (#:plist-184 nil))
  (declare (type generator #:generator-190)
           (type generator #:generator-188)
           (type list #:plist-184))
  (tagbody
   #:ll-191
    (setq #:values-183 (next-in #:generator-190 (go end)))
    (setq #:indicators-182 (next-in #:generator-188 (go end)))
    (setq #:plist-184 (list* #:indicators-182 #:values-183 #:plist-184))
    (go #:ll-191)
   end)
  #:plist-184)


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

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

Input: (-> nil (progn))

Output: (defmacro -> ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-reader-case nil)

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

Input: (with-reader-case nil)

Output: (defmacro WITH-READER-CASE ...)

(let ()
  (let ((#:previous-case178 (readtable-case *readtable*)))
    (setf (readtable-case *readtable*) nil)
    (unwind-protect (progn)
      (setf (readtable-case *readtable*) #:previous-case178))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-*test-dribble* nil (explain! (run 'is1)))

Write a macro that addresses: Macro call that should be transformed by with-*test-dribble*

Input: (with-*test-dribble* nil (explain! (run 'is1)))

Output:
(defmacro with-*test-dribble* (stream &body body)
  `(let ((*test-dribble* ,stream))
     (declare (special *test-dribble*))
     ,@body))

(let ((*test-dribble* nil)) (declare (special *test-dribble*)) (explain! (run (quote is1))))


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

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

Input:
(mvlet* nil
  (progn))

Output: (defmacro MVLET* ...)


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

Problem: Macro call that should be transformed by MATRIX-ETYPECASE

Input: (matrix-etypecase 'some-name)

Output: (defmacro MATRIX-ETYPECASE ...)

(let ((#:g246 quote))
  (etypecase #:g246))


Instruction:
Define a macro that eliminates this repetitive pattern:
(o> (progn (decf test-calls-left) (< *flow-value* iterations)) (-> nil (value) (1+ value)))

Issue: Macro call that should be transformed by o>

Input: (o> (progn (decf test-calls-left) (< *flow-value* iterations)) (-> nil (value) (1+ value)))

Output:
(defmacro o> (condition &body body)
  "See flow:repeatedly"
  `(repeatedly ,condition
     ,@body))

(repeatedly (progn (decf test-calls-left) (< *flow-value* iterations)) (-> nil (value) (1+ value)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(builder (:backtrace :result-on-error (lambda (condition) (if (typep condition 'test-error) '(503 (:content-type "text/plain") ("Service Temporary Unavailable")) '(500 (:content-type "text/plain") ("Internal Server Error"))))) (lambda (env) (if (string= (getf env :path-info) "/503") (error 'test-error) (error "Error occured"))))

Issue: Macro call that should be transformed by builder

Input: (builder (:backtrace :result-on-error (lambda (condition) (if (typep condition 'test-error) '(503 (:content-type "text/plain") ("Service Temporary Unavailable")) '(500 (:content-type "text/plain") ("Internal Server Error"))))) (lambda (env) (if (string= (getf env :path-info) "/503") (error 'test-error) (error "Error occured"))))

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

(reduce (function funcall) (remove-if (function null) (list (lambda (#:app194) (funcall (find-middleware :backtrace) #:app194 :result-on-error (lambda (condition) (if (typep condition (quote test-error)) (quote (503 (:content-type "text/plain") ("Service Temporary Unavailable"))) (quote (500 (:content-type "text/plain") ("Internal Server Error"))))))))) :initial-value (to-app (lambda (env) (if (string= (getf env :path-info) "/503") (error (quote test-error)) (error "Error occured")))) :from-end t)


Instruction:
Generate a defmacro form that transforms code like this:
(c-assert fm)

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

Input: (c-assert fm)

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 fm (c-break "failed assertion: ~a" (quote fm))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-hook-type number->number (function (number) number) "Hook taking a number and returning a number.")

Issue: Macro call that should be transformed by define-hook-type

Input: (define-hook-type number->number (function (number) number) "Hook taking a number and returning a number.")

Output:
(defmacro define-hook-type (name type &optional documentation)
  "Define hook class.
Type must be something like:

  (function (string) (values integer t))

The `handler-type' of the defined hook class has `:class' allocation
type, so that all hooks of such class have the same `handler-type'."
  (let* ((name (string name))
         (hook-class-name (intern (serapeum:concat "HOOK-" name))))
    `(defclass ,hook-class-name (hook)
       ((handler-type :initform ',type :allocation :class))
       (:metaclass closer-mop:funcallable-standard-class)
       ,@(when documentation
           `((:documentation ,documentation))))))

(defclass hook-number->number (hook) ((handler-type :initform (quote (function (number) number)) :allocation :class)) (:metaclass sb-mop:funcallable-standard-class) (:documentation "Hook taking a number and returning a number."))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(multiple-value-bind (form expanded) (macroexpand-1 form *env*) (cond (expanded (e form)) (t (typecase form (null nil) (list (let ((next (compiler-macroexpand-1 form))) (if (eq form next) (handle form) (e next)))) (t `',form)))))

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

Input: (multiple-value-bind (form expanded) (macroexpand-1 form *env*) (cond (expanded (e form)) (t (typecase form (null nil) (list (let ((next (compiler-macroexpand-1 form))) (if (eq form next) (handle form) (e next)))) (t `',form)))))

Output:
(defmacro m (form &environment *env*)
  (e form))

(multiple-value-call (function (lambda (&optional form expanded &rest #:ignore) (declare (ignore #:ignore)) (cond (expanded (e form)) (t (typecase form (null nil) (list (let ((next (compiler-macroexpand-1 form))) (if (eq form next) (handle form) (e next)))) (t (sb-int:quasiquote (quote #S(sb-impl::comma :expr form :kind 0))))))))) (macroexpand-1 form *env*))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(fmap f (funcall p1 next))

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

Input: (fmap f (funcall p1 next))

Output:
(defmacro fmap (f thing)
  "Apply a pure function to the inner contents of some parsing operation, if the
parsing itself was successful."
  `(multiple-value-bind (res next) ,thing
     (if (failure? res)
         (fail next)
         (values (funcall ,f res) next))))

(multiple-value-bind (res next) (funcall p1 next) (if (failure? res) (fail next) (values (funcall f res) next)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(make-instance* 'class (shortcuts) nil)

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

Input: (make-instance* 'class (shortcuts) nil)

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) :shortcuts shortcuts nil)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-op (:case conjunctive-op))

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

Input: (define-op (:case conjunctive-op))

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

(defstruct (case-op (:include conjunctive-op (name "CASE")) (:constructor make-case-op (&rest expressions))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error invalid-context-symbols () (symbols) "Sorry but the following symbols are not valid as a context specifiers: ~{~s~^ ~}" symbols)

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

Input: (define-error invalid-context-symbols () (symbols) "Sorry but the following symbols are not valid as a context specifiers: ~{~s~^ ~}" symbols)

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 invalid-context-symbols (:error-type varjo-error :prefix "Varjo") (symbols) "Sorry but the following symbols are not valid as a context specifiers: ~{~s~^ ~}" symbols)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-test emergency-dependency :depends-on (:not bad-dependency) (true "ALARM!!"))

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

Input: (define-test emergency-dependency :depends-on (:not bad-dependency) (true "ALARM!!"))

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

(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote emergency-dependency) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote emergency-dependency) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (true "ALARM!!"))) :parent (quote nil) (quote :depends-on) (quote (:not bad-dependency)))) (quote emergency-dependency))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-op (:in infix-list-op))

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

Input: (define-op (:in infix-list-op))

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

(defstruct (in-op (:include infix-list-op (name "IN")) (:constructor make-in-op (left right))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause (counting expr &optional into var result-type (type 'fixnum)) "Increment a variable if expression is non-nil" (return-reduction-code :identity 0 :operation '(subst (var expr) (1+ var)) :expression nil :test expr :variable var :type type :accum-kind :increment))

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

Input: (defclause (counting expr &optional into var result-type (type 'fixnum)) "Increment a variable if expression is non-nil" (return-reduction-code :identity 0 :operation '(subst (var expr) (1+ var)) :expression nil :test expr :variable var :type type :accum-kind :increment))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-counting-9 (&key ((:counting expr)) ((:into var)) ((:result-type type) (quote fixnum))) "Increment a variable if expression is non-nil" (return-reduction-code :identity 0 :operation (quote (subst (var expr) (1+ var))) :expression nil :test expr :variable var :type type :accum-kind :increment)) (install-clause-info (quote (counting)) (quote (counting &optional :into :result-type)) (quote clause-counting-9) "Increment a variable if expression is non-nil" nil) (quote (counting expr &optional into var result-type (type (quote fixnum)))))


Instruction:
Generate a defmacro form that transforms code like this:
(integer-writer 4)

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

Input: (integer-writer 4)

Output:
(defmacro integer-writer (bytes)
  "Create a function to write integers to a binary stream."
  (let ((bits (* 8 bytes)))
    `(progn
       (declaim (inline ,(integer-writer-name bytes t)
                        ,(integer-writer-name bytes nil)))
       (defun ,(integer-writer-name bytes nil) (socket value)
         (declare (type stream socket)
                  (type (unsigned-byte ,bits) value)
                  #.*optimize*)
         ,@(if (= bytes 1)
               `((write-byte value socket))
               (loop :for byte :from (1- bytes) :downto 0
                     :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
                                           socket)))
         (values))
       (defun ,(integer-writer-name bytes t) (socket value)
         (declare (type stream socket)
                  (type (signed-byte ,bits) value)
                  #.*optimize*)
         ,@(if (= bytes 1)
               `((write-byte (ldb (byte 8 0) value) socket))
               (loop :for byte :from (1- bytes) :downto 0
                     :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
                                           socket)))
         (values)))))

(progn (declaim (inline write-int4 write-uint4)) (defun write-uint4 (socket value) (declare (type stream socket) (type (unsigned-byte 32) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 24) value) socket) (write-byte (ldb (byte 8 16) value) socket) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)) (defun write-int4 (socket value) (declare (type stream socket) (type (signed-byte 32) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 24) value) socket) (write-byte (ldb (byte 8 16) value) socket) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(c-assert (member old-kid (kids fm-parent)) () "~&oldkid ~s not amongst kids of its fm-parent ~s" old-kid fm-parent)

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

Input: (c-assert (member old-kid (kids fm-parent)) () "~&oldkid ~s not amongst kids of its fm-parent ~s" old-kid fm-parent)

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 (member old-kid (kids fm-parent)) (c-break "~&oldkid ~s not amongst kids of its fm-parent ~s" old-kid fm-parent)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(c? (* 2 (width self)))

Issue: Macro call that should be transformed by c?

Input: (c? (* 2 (width self)))

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

(make-c-dependent :code (quote ((* 2 (width self)))) :value-state :unevaluated :rule (c-lambda (* 2 (width self))))


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

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

Input: (-> nil (progn))

Output: (defmacro -> ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-modf-rewrite cddadr (expr) `(cdr (cdadr ,(second expr))))

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

Input: (define-modf-rewrite cddadr (expr) `(cdr (cdadr ,(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 cddadr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (cdr (cdadr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite cdadr (expr) `(cdr (cadr ,(second expr))))

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

Input: (define-modf-rewrite cdadr (expr) `(cdr (cadr ,(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 cdadr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (cdr (cadr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(class/std stub slot1 slot2 slot3 slot4 slot5)

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

Input: (class/std stub slot1 slot2 slot3 slot4 slot5)

Output:
(defmacro class/std (name &body defaulted-slots)
  "The most concise shortcut macro to DEFCLASS.

  (class/std example slot1 slot2 slot3)

  expands to:

  (DEFCLASS/STD EXAMPLE ()
    ((SLOT1 SLOT2 SLOT3)))

  which expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))
"
  `(defclass/std ,name ()
     ((,@defaulted-slots))))

(defclass/std stub nil ((slot1 slot2 slot3 slot4 slot5)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defdata either (left t) (right t))

Issue: Macro call that should be transformed by defdata

Input: (defdata either (left t) (right t))

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

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

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

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

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

Constructors is a list of clauses with the following grammar:

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

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

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

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

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

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

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

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (either (:constructor nil) (:copier nil) (:predicate nil) (:include algebraic-data-type))) (progn (defstruct (left (:include either) (:constructor left (%0)) (:conc-name left) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-137 #:stream-138 #:depth-139) (declare (ignore #:depth-139) (ignorable #:object-137)) (when *print-adt-readably* (write-string "#." #:stream-138)) (write-char #\LEFT_PARENTHESIS #:stream-138) (prin1 (quote left) #:stream-138) (write-char #\Space #:stream-138) (prin1 (left%0 #:object-137) #:stream-138) (write-char #\RIGHT_PARENTHESIS #:stream-138)))) #A((49) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::EITHER") (%0 (error "Unspecified field.") :type t :read-only t)) (declaim (sb-ext:freeze-type left)) (defmethod make-load-form ((#:object-137 left) &optional #:environment-140) (make-load-form-saving-slots #:object-137 :slot-names (quote (%0)) :environment #:environment-140))) (progn (defstruct (right (:include either) (:constructor right (%0)) (:conc-name right) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-137 #:stream-138 #:depth-139) (declare (ignore #:depth-139) (ignorable #:object-137)) (when *print-adt-readably* (write-string "#." #:stream-138)) (write-char #\LEFT_PARENTHESIS #:stream-138) (prin1 (quote right) #:stream-138) (write-char #\Space #:stream-138) (prin1 (right%0 #:object-137) #:stream-138) (write-char #\RIGHT_PARENTHESIS #:stream-138)))) #A((49) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::EITHER") (%0 (error "Unspecified field.") :type t :read-only t)) (declaim (sb-ext:freeze-type right)) (defmethod make-load-form ((#:object-137 right) &optional #:environment-140) (make-load-form-saving-slots #:object-137 :slot-names (quote (%0)) :environment #:environment-140))) (quote either))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-cache ("foo" :expire 2 :store storage) 2)

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

Input: (with-cache ("foo" :expire 2 :store storage) 2)

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

Example:

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

(let ((#:key257 "foo") (#:store258 storage) (#:expire259 2)) (multiple-value-bind (#:value260 #:exists-p261) (getcache #:key257 #:store258) (if #:exists-p261 #:value260 (let ((#:value260 (progn 2))) (setcache #:key257 #:value260 #:store258 :expire #:expire259) #:value260))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(set-data pt (rect y x))

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

Input: (set-data pt (rect y x))

Output:
(defmacro set-data (obj (name &rest new-values))
  "Mutate the fields of the ADT value OBJ whose constructor is NAME
and whose updated values are NEW-VALUES based on order. If the symbol
'_' is used as a value, that field is not updated. Trailing '_' may be
omitted."
  (let ((once (gensym "ONCE")))
    `(let ((,once ,obj))
       (psetf
        ,@(loop :for i :from 0
                :for x :in new-values
                :when (not (wild? x))
                  :append (list `(,(field name i) ,once)
                                x))))))

(let ((#:once145 pt)) (psetf (rect%0 #:once145) y (rect%1 #:once145) x))


Instruction:
Generate a defmacro form that transforms code like this:
(defcategory :info (or :info :notice))

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

Input: (defcategory :info (or :info :notice))

Output:
(defmacro defcategory (category &optional expands-as set)
  `(defcategory-fn ',category ',expands-as ,set))

(defcategory-fn (quote :info) (quote (or :info :notice)) nil)


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

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

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

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

(let* ((descriptive-lambda-list (loop :for #:g126 :in specialized-lambda-list :if (listp #:g126) :collect #:g126 :else :collect (list #:g126 t))) (vanilla-lambda-list (mapcar (function first) descriptive-lambda-list)) (type-list (mapcar (function second) descriptive-lambda-list))) (declare (ignorable descriptive-lambda-list vanilla-lambda-list type-list)) (with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) (sb-int:quasiquote (progn (%defhook-fun #S(sb-impl::comma :expr hook-name :kind 0) #S(sb-impl::comma :expr vanilla-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)) (%define-method-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr specialized-lambda-list :kind 0))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(some-<>> nil :key nil)

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

Input: (some-<>> nil :key nil)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(insert-char-class-tester (char-class (schar *string* start-pos)) (lambda (start-pos) (declare (fixnum start-pos)) (and (< start-pos *end-pos*) (char-class-test) (funcall next-fn (1+ start-pos)))))

Write a macro that addresses: Macro call that should be transformed by insert-char-class-tester

Input: (insert-char-class-tester (char-class (schar *string* start-pos)) (lambda (start-pos) (declare (fixnum start-pos)) (and (< start-pos *end-pos*) (char-class-test) (funcall next-fn (1+ start-pos)))))

Output:
(defmacro insert-char-class-tester ((char-class chr-expr) &body body)
  "Utility macro to replace each occurence of '\(CHAR-CLASS-TEST)
within BODY with the correct test (corresponding to CHAR-CLASS)
against CHR-EXPR."
  (with-rebinding (char-class)
    (with-unique-names (test-function)
      (flet ((substitute-char-class-tester (new)
               (subst new '(char-class-test) body
                      :test #'equalp)))
        `(let ((,test-function (test-function ,char-class)))
           ,@(substitute-char-class-tester
              `(funcall ,test-function ,chr-expr)))))))

(let ((#:char-class155 char-class)) (let ((#:test-function156 (test-function #:char-class155))) (lambda (start-pos) (declare (fixnum start-pos)) (and (< start-pos *end-pos*) (funcall #:test-function156 (schar *string* start-pos)) (funcall next-fn (1+ start-pos))))))


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

Issue: Macro call that should be transformed by GATHERER

Input: (gatherer 'some-name)

Output: (defmacro GATHERER ...)

(common-lisp:let ((#:lastcons-452 (list nil)) #:lst-453)
  (declare (type cons #:lastcons-452)
           (type list #:lst-453))
  (setq #:lst-453 #:lastcons-452)
  (common-lisp:let (#:out-455)
    #'(lambda (#:items-451 result-p)
        (cond
         ((null result-p)
          (tagbody
            (setq #:lastcons-452
                    (setf (cdr #:lastcons-452) (cons #:items-451 nil)))))
         (t
          (progn
           (setq #:lst-453 (cdr #:lst-453))
           (setq #:out-455
                   (common-lisp:funcall 'some-name
                                        (common-lisp:funcall #'scan
                                                             #:lst-453))))
          #:out-455)))))


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

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

Input:
(*let nil
  :key
  nil)

Output: (defmacro *LET ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-store-entry (key store :quiet quiet) (when (item key store) (trc "overwriting item" key (item key store))) (setf (item key store) object))

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

Input: (with-store-entry (key store :quiet quiet) (when (item key store) (trc "overwriting item" key (item key store))) (setf (item key store) object))

Output:
(defmacro with-store-entry ((key store &key quiet) &body body)
  `(prog1
       (progn
	 ,@body)
     (unless ,quiet
       (kick-c-link ,key ,store))))

(prog1 (progn (when (item key store) (trc "overwriting item" key (item key store))) (setf (item key store) object)) (unless quiet (kick-c-link key store)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(make-stream-method pp-xml-value (s (value ratio) &optional colon-p at-p) (declare (ignore colon-p at-p)) (format s "~v$" *float-format-precision* value))

What needs to change: Macro call that should be transformed by make-stream-method

Input: (make-stream-method pp-xml-value (s (value ratio) &optional colon-p at-p) (declare (ignore colon-p at-p)) (format s "~v$" *float-format-precision* value))

Output:
(defmacro make-stream-method (name (s &rest args) &body body)
  `(progn
     (defmethod ,name ((,s stream) ,@args)
       ,@body)
     #+abcl
     (defmethod ,name ((,s xp::xp-structure) ,@args)
       ,@body)))

(progn (defmethod pp-xml-value ((s stream) (value ratio) &optional colon-p at-p) (declare (ignore colon-p at-p)) (format s "~v$" *float-format-precision* value)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(class/std example slot1 slot2 slot3)

Issue: Macro call that should be transformed by class/std

Input: (class/std example slot1 slot2 slot3)

Output:
(defmacro class/std (name &body defaulted-slots)
  "The most concise shortcut macro to DEFCLASS.

  (class/std example slot1 slot2 slot3)

  expands to:

  (DEFCLASS/STD EXAMPLE ()
    ((SLOT1 SLOT2 SLOT3)))

  which expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))
"
  `(defclass/std ,name ()
     ((,@defaulted-slots))))

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


Instruction:
Generate a defmacro form that transforms code like this:
(builder (:backtrace :result-on-error `(500 (:content-type "text/plain") ("Internal Server Error"))) (lambda (env) (if (string= (getf env :path-info) "/error") (error "Error occured") '(200 () ("ok")))))

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

Input: (builder (:backtrace :result-on-error `(500 (:content-type "text/plain") ("Internal Server Error"))) (lambda (env) (if (string= (getf env :path-info) "/error") (error "Error occured") '(200 () ("ok")))))

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

(reduce (function funcall) (remove-if (function null) (list (lambda (#:app190) (funcall (find-middleware :backtrace) #:app190 :result-on-error (sb-int:quasiquote (500 (:content-type "text/plain") ("Internal Server Error"))))))) :initial-value (to-app (lambda (env) (if (string= (getf env :path-info) "/error") (error "Error occured") (quote (200 nil ("ok")))))) :from-end t)


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

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

Input: (dynenv-macrolet nil)

Output: (defmacro DYNENV-MACROLET ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(action (:after node-application) #'rewrite-direct-application)

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

Input: (action (:after node-application) #'rewrite-direct-application)

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-application) (function rewrite-direct-application))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun-advisable nil
    nil)

Issue: Macro call that should be transformed by DEFUN-ADVISABLE

Input:
(defun-advisable nil
    nil)

Output: (defmacro DEFUN-ADVISABLE ...)

(let ((#:oldfn134
       (handler-case (symbol-function 'nil) (undefined-function nil nil))))
  (defun nil ())
  (make-advisable 'nil :arguments 'nil)
  (when
      (and #:oldfn134
           (not (eql (advisable-function-arguments #:oldfn134) :not-provided))
           (equal (advisable-function-arguments #:oldfn134) 'nil))
    (copy-advice #:oldfn134 (symbol-function 'nil))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(ematch0 (remove-if-not (curry #'eq symbol) slots :key #'c2mop:slot-definition-name) ((list) (when slots (simple-style-warning "Found slots ~{~s~^, ~} but they are not EQ to ~s." (mapcar #'c2mop:slot-definition-name slots) symbol))) ((list slot) (return slot)))

Issue: Macro call that should be transformed by ematch0

Input: (ematch0 (remove-if-not (curry #'eq symbol) slots :key #'c2mop:slot-definition-name) ((list) (when slots (simple-style-warning "Found slots ~{~s~^, ~} but they are not EQ to ~s." (mapcar #'c2mop:slot-definition-name slots) symbol))) ((list slot) (return slot)))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 (remove-if-not (curry (function eq) symbol) slots :key (function sb-mop:slot-definition-name)) ((list) (when slots (simple-style-warning "Found slots ~{~s~^, ~} but they are not EQ to ~s." (mapcar (function sb-mop:slot-definition-name) slots) symbol))) ((list slot) (return slot)) (_ (error "level0 match error!")))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(make-$instance nil)

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

Input: (make-$instance nil)

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-wcs-math-error-handling ((quot rem) (ftruncate x)) (check-wcs-math-result) (values rem quot))

Write a macro that addresses: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling ((quot rem) (ftruncate x)) (check-wcs-math-result) (values rem quot))

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

(let* ((#:g233 x) (#:g234 nil) (#:g235 (list #:g233))) (declare (ignorable #:g234) (type list #:g235) (dynamic-extent #:g235)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (quot rem) (call-with-wcs-math-error-handler (quote ftruncate) #:g235) (flet ((check-wcs-math-result (&optional (ret quot) (arg-list #:g235)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result) (values rem quot)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(drelet* nil
  (progn))

Problem: Macro call that should be transformed by DRELET*

Input:
(drelet* nil
  (progn))

Output: (defmacro DRELET* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(deferror "42710" duplicate-object syntax-error-or-access-violation)

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

Input: (deferror "42710" duplicate-object syntax-error-or-access-violation)

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

(progn (define-condition duplicate-object (syntax-error-or-access-violation) nil) (setf (gethash "42710" *error-table*) (quote duplicate-object)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is 'foo 'foo "Foo with multiline description!")

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

Input: (is 'foo 'foo "Foo with multiline description!")

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

(let ((#:expected194 (quote foo))) (let* ((#:new-args192 (list "Foo with multiline description!")) (#:desc193 (parse-description-and-test #:new-args192))) (with-catching-errors (:description #:desc193 :expected #:expected194) (with-duration ((#:duration190 #:result191) (quote foo)) (test #:result191 #:expected194 #:new-args192 :duration #:duration190)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(-> :one :ignore-invariant t () (increment))

Problem: Macro call that should be transformed by ->

Input: (-> :one :ignore-invariant t () (increment))

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

(atomically :one :ignore-invariant t nil (increment))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> +comma+ +skip-space+)

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

Input: (*> +comma+ +skip-space+)

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 (#:*>-offset233) (multiple-value-bind (#:*>-res234 #:*>-next235) (funcall +comma+ #:*>-offset233) (if (ok? #:*>-res234) (funcall +skip-space+ #:*>-next235) (fail #:*>-next235))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(-> :g (a) (+ a 4))

Issue: Macro call that should be transformed by ->

Input: (-> :g (a) (+ a 4))

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