Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(def-iter iterator-enumerate (iterator curr) (enumerate (iterable &optional (curr 0)) "Yield two-element lists of indices (beginning at curr) and their corresponding elements in `iterable` ``` (enumerate '(a b c d)) ;; (0 a), (1 b), (2 c), (3 d) (enumerate '(a b c d) 3) ;; (3 a), (4 b), (5 c), (6 d) ```" (init-state (iterator (make-iterator iterable)) curr)) (multiple-value-bind (item alive) (next iterator) (if alive (multiple-value-prog1 (values (list curr item) t) (incf curr)) (values nil nil))))

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

Input: (def-iter iterator-enumerate (iterator curr) (enumerate (iterable &optional (curr 0)) "Yield two-element lists of indices (beginning at curr) and their corresponding elements in `iterable` ``` (enumerate '(a b c d)) ;; (0 a), (1 b), (2 c), (3 d) (enumerate '(a b c d) 3) ;; (3 a), (4 b), (5 c), (6 d) ```" (init-state (iterator (make-iterator iterable)) curr)) (multiple-value-bind (item alive) (next iterator) (if alive (multiple-value-prog1 (values (list curr item) t) (incf curr)) (values nil nil))))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname132 (&key iterator curr) (labels ((self nil (multiple-value-bind (item alive) (next iterator) (if alive (multiple-value-prog1 (values (list curr item) t) (incf curr)) (values nil nil))))) (function self)))) (defun enumerate (iterable &optional (curr 0)) "Yield two-element lists of indices (beginning at curr) and their corresponding elements in `iterable` ``` (enumerate '(a b c d)) ;; (0 a), (1 b), (2 c), (3 d) (enumerate '(a b c d) 3) ;; (3 a), (4 b), (5 c), (6 d) ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname132)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (iterator (make-iterator iterable)) curr))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-custom-var (:end-of-object *end-of-object-handler*))

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(acond ((null 1) (list :no it)) ((+ 1 2) (list :yes it)) (t :nono))

Issue: Macro call that should be transformed by acond

Input: (acond ((null 1) (list :no it)) ((+ 1 2) (list :yes it)) (t :nono))

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 (null 1))) (if #:it (let ((it #:it)) (declare (ignorable it)) (list :no it)) (acond ((+ 1 2) (list :yes it)) (t :nono))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(-> (from :users) (when active-only (where (:= :active 1))) (when sort-by-name (order-by :name)))

Issue: Macro call that should be transformed by ->

Input: (-> (from :users) (when active-only (where (:= :active 1))) (when sort-by-name (order-by :name)))

Output:
(defmacro -> (value &rest forms)
  "Smart threading macro that dispatches based on clause types returned by forms.

   This macro enables immutable query composition by threading clauses through
   query-state objects. Creates a single copy at the beginning, then destructively
   adds clauses for efficiency. Supports both v1 select-statements and composer query-states.

   Forms that evaluate to NIL are skipped, enabling conditional composition:
     (-> (from :users)
         (when active-only (where (:= :active 1)))
         (when sort-by-name (order-by :name)))

   Examples:
     ;; With composer clause
     (-> (from :users)
         (where (:= :active 1))
         (order-by :name))

     ;; With v1 select-statement (backward compatible)
     (-> (select (:id :name) (from :users))
         (where (:= :active 1))
         (order-by :name))

     ;; Conditional composition
     (-> (from :users)
         (when include-inactive (where (:= :active 0)))
         (when sort-by-date (order-by :created_at)))"
  (a:with-gensyms (threaded-var clause-var)
    `(let* ((,threaded-var ,value)
            ;; Convert to query-state and copy once at the beginning
            (,threaded-var
              (typecase ,threaded-var
                (query-state-base (copy-query-state-immutable ,threaded-var))
                (stmt:select-statement (select-statement-to-query-state ,threaded-var))
                (stmt:insert-into-statement (insert-statement-to-query-state ,threaded-var))
                (stmt:update-statement (update-statement-to-query-state ,threaded-var))
                (stmt:delete-from-statement (delete-statement-to-query-state ,threaded-var))
                (otherwise (add-clause (make-select-query-state) ,threaded-var)))))
       ;; Now destructively add clauses (no more copying), skipping NILs
       ,@(loop for form in forms
               collect `(let ((,clause-var ,(if (listp form)
                                                ;; For list forms, call the function with its arguments (no threading)
                                                `(,(car form) ,@(cdr form))
                                                ;; For symbol forms, call the function with no arguments
                                                `(,form))))
                          (when ,clause-var
                            (add-clause ,threaded-var ,clause-var))))
       ,threaded-var)))

(let* ((#:threaded-var141 (from :users)) (#:threaded-var141 (typecase #:threaded-var141 (query-state-base (copy-query-state-immutable #:threaded-var141)) (stmt:select-statement (select-statement-to-query-state #:threaded-var141)) (stmt:insert-into-statement (insert-statement-to-query-state #:threaded-var141)) (stmt:update-statement (update-statement-to-query-state #:threaded-var141)) (stmt:delete-from-statement (delete-statement-to-query-state #:threaded-var141)) (otherwise (add-clause (make-select-query-state) #:threaded-var141))))) (let ((#:clause-var142 (when active-only (where (:= :active 1))))) (when #:clause-var142 (add-clause #:threaded-var141 #:clause-var142))) (let ((#:clause-var142 (when sort-by-name (order-by :name)))) (when #:clause-var142 (add-clause #:threaded-var141 #:clause-var142))) #:threaded-var141)


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

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

Input: (do-iterator 'some-name)

Output: (defmacro DO-ITERATOR ...)

(block nil
  (let ((#:g407 (iterator some-name)))
    (unwind-protect
        (loop named #:g410
              for (#:g408 #:g409) = (multiple-value-list
                                     (iterator-next! #:g407))
              while #:g409
              for quote = #:g408
              do (progn))
      (iterator-finish! #:g407))))


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

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

Input:
(as-> nil
    nil)

Output: (defmacro AS-> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(declare-unary-operator nil)

Pattern to recognize: Macro call that should be transformed by DECLARE-UNARY-OPERATOR

Input: (declare-unary-operator nil)

Output: (defmacro DECLARE-UNARY-OPERATOR ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (infix-math/data::save-unary-operator 'nil))


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

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

Input: ($send nil :key nil)

Output: (defmacro $SEND ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ensure-getf options :binder binder)

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

Input: (ensure-getf options :binder binder)

Output:
(defmacro ensure-getf (place key &optional default)
  (once-only (key default)
    `(setf (getf ,place ,key) (getf ,place ,key ,default))))

(let ((#:key171 :binder) (#:default172 binder)) (setf (getf options #:key171) (getf options #:key171 #:default172)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-op (:is-not-distinct-from infix-op))

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

Input: (define-op (:is-not-distinct-from infix-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 (is-not-distinct-from-op (:include infix-op (name "IS NOT DISTINCT FROM")) (:constructor make-is-not-distinct-from-op (left right))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(mapcar 'e list)

Issue: Macro call that should be transformed by m

Input: (mapcar 'e list)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(lret ((out (make-array len :element-type (array-element-type array)))) (replace* out (%flatten array)))

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

Input: (lret ((out (make-array len :element-type (array-element-type array)))) (replace* out (%flatten array)))

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

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

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

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

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

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

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

(lret-aux let ((out (make-array len :element-type (array-element-type array)))) (replace* out (%flatten array)))


Instruction:
Generate a defmacro form that transforms code like this:
(defclause (maximize expr &optional into var) "Maximize value of an expression" (return-extremum-code expr var 'max))

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

Input: (defclause (maximize expr &optional into var) "Maximize value of an expression" (return-extremum-code expr var 'max))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-maximize-12 (&key ((:maximize expr)) ((:into var))) "Maximize value of an expression" (return-extremum-code expr var (quote max))) (install-clause-info (quote (maximize)) (quote (maximize &optional :into)) (quote clause-maximize-12) "Maximize value of an expression" nil) (quote (maximize expr &optional into var)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvar-unbound *term-char* "Bound to the closing outer delimiter while parsing a string.")

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

Input: (defvar-unbound *term-char* "Bound to the closing outer delimiter while parsing a string.")

Output:
(defmacro defvar-unbound (variable-name documentation)
  "Like DEFVAR, but the variable will be unbound rather than getting
an initial value.  This is useful for variables which should have no
global value but might have a dynamically bound value."
  ;; stolen from comp.lang.lisp article <k7727i3s.fsf@comcast.net> by
  ;; "prunesquallor@comcast.net"
  `(eval-when (:load-toplevel :compile-toplevel :execute)
    (defvar ,variable-name)
    (setf (documentation ',variable-name 'variable)
            ,documentation)))

(eval-when (:load-toplevel :compile-toplevel :execute) (defvar *term-char*) (setf (documentation (quote *term-char*) (quote variable)) "Bound to the closing outer delimiter while parsing a string."))


Instruction:
Generate a defmacro form that transforms code like this:
(define-cfun __errno_location)

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

Input: (define-cfun __errno_location)

Output:
(defmacro define-cfun (name-or-function &optional (package *package*))
  (when-let ((fun (find-function name-or-function)))
    (with-wrap-attempt ("function ~S" name-or-function) name-or-function
      (with-slots (name type c-symbol fields) fun
        (let* ((fun-name (intern (symbol-name name) package))
               (param-names (mapcar #'foreign-type-name fields))
               (param-syms (mapcar (lambda (x) (gensym (symbol-name x))) param-names))
               (make-function-p (not (foreign-function-variadic-p fun)))
               (maybe-cbv-return
                 (when (cbv-return-p fun)
                   (list 'return-value))))
          (with-gensyms (!fun !fields rest)
            (let ((form
                    (if make-function-p
                        `(defun ,fun-name (,@maybe-cbv-return
                                           ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           ,(let ((!fun (find-function name-or-function)))
                              (with-slots ((!fields fields)) !fun
                                (foreign-to-ffi
                                 (and (car !fields) (foreign-type (car !fields)))
                                 param-syms
                                 param-names
                                 !fields
                                 (make-foreign-funcall !fun (and maybe-cbv-return 'return-value)
                                                       param-syms (when (foreign-function-variadic-p fun) rest))))))
                        `(defmacro ,fun-name (,@maybe-cbv-return
                                              ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           (let ((,!fun (find-function ',name-or-function)))
                             (with-slots ((,!fields fields)) ,!fun
                               (foreign-to-ffi
                                (and (car ,!fields) (foreign-type (car ,!fields)))
                                ',param-syms
                                (list ,@param-names)
                                ,!fields
                                (make-foreign-funcall ,!fun ,(and maybe-cbv-return 'return-value)
                                                      ',param-syms ,(when (foreign-function-variadic-p fun) rest)))))))))
              `(progn
                 ,@(when (foreign-function-cbv-p fun)
                     (list (funcall *build-libffi-definition* fun)))
                 ,form))))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-variable node) (setf node-vars (adjoin (node-variable-value node) node-vars)) (values))

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

Input: (action (:after node-variable node) (setf node-vars (adjoin (node-variable-value node) node-vars)) (values))

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

(make-action (quote :after) (quote node-variable) (lambda (node) (declare (type node-variable node)) (setf node-vars (adjoin (node-variable-value node) node-vars)) (values)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(adding-smart-slot-methods obj slot (slot-value obj slot))

What needs to change: Macro call that should be transformed by adding-smart-slot-methods

Input: (adding-smart-slot-methods obj slot (slot-value obj slot))

Output:
(defmacro adding-smart-slot-methods (obj slot expr)
  (with-gensyms (err class name alt args val)
    `(handler-case ,expr
       (simple-error (,err)
         (let ((,class (class-of ,obj))
               (,name (symbol-name ,slot)))
           (dolist (,alt (c2mop:class-slots ,class)
                         (error ,err))
             (let ((,alt (c2mop:slot-definition-name ,alt)))
               (when (string= ,name (symbol-name ,alt))
                 (add-method (ensure-generic-function 'smart-slot-value)
                             (make-instance
                              'standard-method
                              :specializers
                              (list ,class
                                    (c2mop:intern-eql-specializer ,slot))
                              :lambda-list '(,obj ,slot)
                              :function
                              (lambda (,args _)
                                (declare (ignorable _))
                                (slot-value (first ,args) ,alt))))
                 (add-method (ensure-generic-function 'smart-set-slot-value)
                             (make-instance
                              'standard-method
                              :specializers
                              (list ,class
                                    (c2mop:intern-eql-specializer ,slot)
                                    (find-class 't))
                              :lambda-list '(,obj ,slot ,val)
                              :function
                              (lambda (,args _)
                                (declare (ignorable _))
                                (:= (slot-value (first ,args) ,alt)
                                    (third ,args)))))
                 (let ((,slot ,alt))
                   (return ,expr))))))))))

(handler-case (slot-value obj slot) (simple-error (#:g149) (let ((#:g150 (class-of obj)) (#:g151 (symbol-name slot))) (dolist (#:g152 (sb-mop:class-slots #:g150) (error #:g149)) (let ((#:g152 (sb-mop:slot-definition-name #:g152))) (when (string= #:g151 (symbol-name #:g152)) (add-method (ensure-generic-function (quote smart-slot-value)) (make-instance (quote standard-method) :specializers (list #:g150 (sb-mop:intern-eql-specializer slot)) :lambda-list (quote (obj slot)) :function (lambda (#:g153 _) (declare (ignorable _)) (slot-value (first #:g153) #:g152)))) (add-method (ensure-generic-function (quote smart-set-slot-value)) (make-instance (quote standard-method) :specializers (list #:g150 (sb-mop:intern-eql-specializer slot) (find-class (quote t))) :lambda-list (quote (obj slot #:g154)) :function (lambda (#:g153 _) (declare (ignorable _)) (:= (slot-value (first #:g153) #:g152) (third #:g153))))) (let ((slot #:g152)) (return (slot-value obj slot)))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-condition/a dbi-unimplemented-error (dbi-interface-error) ((method-name :initarg :method-name :type (or symbol string))) (:documentation "Exception raised if the DBD driver has not specified a mandatory method.") (:report (lambda (condition stream) (format stream "`~A' must be implemented." (slot-value condition 'method-name)))))

Pattern to recognize: Macro call that should be transformed by define-condition/a

Input: (define-condition/a dbi-unimplemented-error (dbi-interface-error) ((method-name :initarg :method-name :type (or symbol string))) (:documentation "Exception raised if the DBD driver has not specified a mandatory method.") (:report (lambda (condition stream) (format stream "`~A' must be implemented." (slot-value condition 'method-name)))))

Output:
(defmacro define-condition/a (name parent-types slots &body options)
  `(progn
     (define-condition ,name ,parent-types ,slots ,@options)
     (deftype ,(intern (format nil "<~A>" (symbol-name name))) () ',name)
     (setf (find-class ',(intern (format nil "<~A>" (symbol-name name))))
           (find-class ',name))))

(progn (define-condition dbi-unimplemented-error (dbi-interface-error) ((method-name :initarg :method-name :type (or symbol string))) (:documentation "Exception raised if the DBD driver has not specified a mandatory method.") (:report (lambda (condition stream) (format stream "`~A' must be implemented." (slot-value condition (quote method-name)))))) (deftype <dbi-unimplemented-error> nil (quote dbi-unimplemented-error)) (setf (find-class (quote <dbi-unimplemented-error>)) (find-class (quote dbi-unimplemented-error))))


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

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

Input:
(max-of nil
  nil)

Output: (defmacro MAX-OF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time check-function-name (function-name) (unless (valid-function-name? function-name) (error "Invalid function name: ~S" function-name)))

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

Input: (defun-compile-time check-function-name (function-name) (unless (valid-function-name? function-name) (error "Invalid function name: ~S" function-name)))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun check-function-name (function-name) (unless (valid-function-name? function-name) (error "Invalid function name: ~S" function-name))) (eval-when (:compile-toplevel) (compile (quote check-function-name))))


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

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

Input: (js nil)

Output: (defmacro JS ...)


Instruction:
Generate a defmacro form that transforms code like this:
(true (< 8 5))

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

Input: (true (< 8 5))

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (true (< 8 5))) :value-form (quote (< 8 5)) :body (lambda nil (< 8 5)) :expected (quote t) :comparison (quote geq)))


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

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

Input: (subtest "Inner testcase with multiline description." (is 'foo 'foo "Foo with multiline description!"))

Output:
(defmacro subtest (desc &body body)
  `(%subtest ,desc (lambda () ,@body)))

(%subtest "Inner testcase with multiline description." (lambda nil (is (quote foo) (quote foo) "Foo with multiline description!")))


Instruction:
Generate a defmacro form that transforms code like this:
(augment decls decs)

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

Input: (augment decls decs)

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


Instruction:
Generate a defmacro form that transforms code like this:
(with-html-string (let ((*print-pretty*)) (:div (:textarea "123"))))

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

Input: (with-html-string (let ((*print-pretty*)) (:div (:textarea "123"))))

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

(with-output-to-string (*html*) (with-html (let ((*print-pretty*)) (:div (:textarea "123")))))


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator (x (list->generator data)) (yield x))

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

Input: (do-generator (x (list->generator data)) (yield x))

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 ((#:g170 (list->generator data))) (loop do (if-generator ((x) #:g170) (progn (yield x)) (return))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-op (:as infix-splicing-op))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-option-expander size (package n) (declare (ignore n)) (error "SIZE option not applicable."))

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

Input: (define-option-expander size (package n) (declare (ignore n)) (error "SIZE option not applicable."))

Output:
(defmacro define-option-expander (name (package &rest arguments) &body body)
  (let ((args (gensym "ARGS")))
    `(defmethod expand-option ((,(gensym "TYPE") (eql ,(intern (string name) "KEYWORD"))) ,package ,args)
       (destructuring-bind ,arguments ,args
         ,@body))))

(defmethod expand-option ((#:type138 (eql :size)) package #:args137) (destructuring-bind (n) #:args137 (declare (ignore n)) (error "SIZE option not applicable.")))


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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(compile-$flavor-$methods nil nil)

What needs to change: Macro call that should be transformed by COMPILE-$FLAVOR-$METHODS

Input: (compile-$flavor-$methods nil nil)

Output: (defmacro COMPILE-$FLAVOR-$METHODS ...)

(eval-when (:load-toplevel) (combine-class-methods nil nil))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is (= 2 b))

Problem: Macro call that should be transformed by is

Input: (is (= 2 b))

Output:
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

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

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

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

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

(let ((#:e271 2) (#:a272 b)) (if (progn (= #:e271 #:a272)) (add-result (quote test-passed) :test-expr (quote (= 2 b))) (process-failure (quote (= 2 b)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote b) #:a272 (quote =) #:e271)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-header-output (buffer) (let ((cookies (cookie-jar-host-cookies cookie-jar (uri-host uri) (or (uri-path uri) "/") :securep (string= (uri-scheme uri) "https")))) (when cookies (fast-write-sequence (ascii-string-to-octets "Cookie: ") buffer) (fast-write-sequence (ascii-string-to-octets (write-cookie-header cookies)) buffer) (fast-write-sequence +crlf+ buffer))))

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

Input: (with-header-output (buffer) (let ((cookies (cookie-jar-host-cookies cookie-jar (uri-host uri) (or (uri-path uri) "/") :securep (string= (uri-scheme uri) "https")))) (when cookies (fast-write-sequence (ascii-string-to-octets "Cookie: ") buffer) (fast-write-sequence (ascii-string-to-octets (write-cookie-header cookies)) buffer) (fast-write-sequence +crlf+ buffer))))

Output:
(defmacro with-header-output ((buffer &optional output) &body body)
  `(with-fast-output (,buffer ,output)
     (declare (ignorable ,buffer))
     (let ((*header-buffer* ,buffer))
       ,@body)))

(with-fast-output (buffer nil) (declare (ignorable buffer)) (let ((*header-buffer* buffer)) (let ((cookies (cookie-jar-host-cookies cookie-jar (uri-host uri) (or (uri-path uri) "/") :securep (string= (uri-scheme uri) "https")))) (when cookies (fast-write-sequence (ascii-string-to-octets "Cookie: ") buffer) (fast-write-sequence (ascii-string-to-octets (write-cookie-header cookies)) buffer) (fast-write-sequence +crlf+ buffer)))))


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator-value-list (vars (apply #'multi-gen (loop for g in gens collect (list g :fill-value fillspec)))) (apply #'yield (mapcar #'car vars)))

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

Input: (do-generator-value-list (vars (apply #'multi-gen (loop for g in gens collect (list g :fill-value fillspec)))) (apply #'yield (mapcar #'car vars)))

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 ((#:g158 (apply (function multi-gen) (loop for g in gens collect (list g :fill-value fillspec))))) (loop do (if-generator (vars #:g158) (progn (apply (function yield) (mapcar (function car) vars))) (return))))


Instruction:
Generate a defmacro form that transforms code like this:
(signal-syntax-error "Variable length look-behind not implemented \(yet): ~S." parse-tree)

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

Input: (signal-syntax-error "Variable length look-behind not implemented \(yet): ~S." parse-tree)

Output:
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

(signal-syntax-error* nil "Variable length look-behind not implemented (yet): ~S." parse-tree)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defun/1 freopen (filename mode fd) (handler-case (progn (fclose fd) (clearerr fd) (setf (fd-stream fd) (open-stream filename mode))) (error () (setf errno EIO) NULL)))

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

Input: (defun/1 freopen (filename mode fd) (handler-case (progn (fclose fd) (clearerr fd) (setf (fd-stream fd) (open-stream filename mode))) (error () (setf errno EIO) NULL)))

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 freopen (filename mode fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (handler-case (progn (fclose fd) (clearerr fd) (setf (fd-stream fd) (open-stream filename mode))) (error nil (setf errno eio) null))) (defparameter freopen (vacietis.c:mkptr& (symbol-function (quote freopen)))))


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

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

Input: (->* nil)

Output: (defmacro ->* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(defgenerator imap (function &rest generators) "The generator equivalent of the mapcar function. Applies function to the values of the supplied generators, emitting the result. Eg: (imap #'* (list->generator '(2 3 4)) (list->generator '(4 5 6))) -> 8 15 24" (do-generator-value-list (vals (apply #'multi-gen generators)) (yield (apply function (mapcar #'car vals)))))

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

Input: (defgenerator imap (function &rest generators) "The generator equivalent of the mapcar function. Applies function to the values of the supplied generators, emitting the result. Eg: (imap #'* (list->generator '(2 3 4)) (list->generator '(4 5 6))) -> 8 15 24" (do-generator-value-list (vals (apply #'multi-gen generators)) (yield (apply function (mapcar #'car vals)))))

Output:
(defmacro defgenerator (name arguments &body body)
  (multiple-value-bind (remaining-forms declarations doc-string)
      (alexandria:parse-body body :documentation t)
    `(defun ,name ,arguments
       ,doc-string
       ,@declarations
       (with-yield
	 ,@remaining-forms))))

(defun imap (function &rest generators) "The generator equivalent of the mapcar function. Applies function to the values of the supplied generators, emitting the result. Eg: (imap #'* (list->generator '(2 3 4)) (list->generator '(4 5 6))) -> 8 15 24" (with-yield (do-generator-value-list (vals (apply (function multi-gen) generators)) (yield (apply function (mapcar (function car) vals))))))


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

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

Input: (count-of 'some-name)

Output: (defmacro COUNT-OF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(is (= 1 (length results)))

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

Input: (is (= 1 (length results)))

Output:
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

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

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

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

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

(let ((#:e211 1) (#:a212 (length results))) (if (progn (= #:e211 #:a212)) (add-result (quote test-passed) :test-expr (quote (= 1 (length results)))) (process-failure (quote (= 1 (length results))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (length results)) #:a212 (quote =) #:e211)))


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

Problem: Macro call that should be transformed by DLETF*

Input:
(dletf* nil
  nil)

Output: (defmacro DLETF* ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(lambda-ematch (PATTERN BODY...))

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

Input: (lambda-ematch (PATTERN BODY...))

Output:
(defmacro lambda-ematch (&body clauses)
  "Equivalent to (lambda (arg) (ematch arg CLAUSES...))."
  (with-unique-names (arg)
    `(lambda (,arg) (ematch ,arg ,@clauses))))

(lambda (#:arg123) (ematch #:arg123 (pattern body...)))


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

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

Input: (*let 'some-name)

Output: (defmacro *LET ...)


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

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

Input: (defpackage nil)

Output: (defmacro DEFPACKAGE ...)


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

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

Input:
(with-local-readtable
  'some-name)

Output: (defmacro WITH-LOCAL-READTABLE ...)

(bind ((*readtable* (copy-readtable *readtable*)))
  'some-name)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-method-combination% min :operator min :identity-with-one-argument t)

Problem: Macro call that should be transformed by define-method-combination%

Input: (define-method-combination% min :operator min :identity-with-one-argument t)

Output:
(defmacro define-method-combination% (name &rest args)
  "Define a method-combination for the static-dispatch system only.

   Arguments are of the same form as to CL:DEFINE-METHOD-COMBINATION."

  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (combination-function ',name)
      ,(match args
         ((or nil
              (list* (and (type symbol) (not nil)) _))

          (destructuring-bind (&key (operator name) (identity-with-one-argument nil))
              args

            `(method-combination-function-short ,name ,operator ,identity-with-one-argument)))

         (_
          `(method-combination-function ,name ,@args))))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (combination-function (quote min)) (method-combination-function-short min min t)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(builder nil (if t nil nil) nil *app*)

Issue: Macro call that should be transformed by builder

Input: (builder nil (if t nil nil) nil *app*)

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 (let ((#:res171 (if t nil nil))) (typecase #:res171 (keyword (find-middleware #:res171)) (cons (if (keywordp (car #:res171)) (let ((#:res-mw170 (find-middleware (car #:res171)))) (lambda (#:app169) (apply #:res-mw170 #:app169 (cdr #:res171)))) #:res171)) (standard-object (lambda (#:app169) (funcall (intern (string :wrap) :clack.middleware) #:res171 #:app169))) (otherwise #:res171))))) :initial-value (to-app *app*) :from-end t)


Instruction:
Generate a defmacro form that transforms code like this:
(->*)

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

Output: (defmacro ->* ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(make-instance* 'class ())

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(fmap (lambda (s) (let ((*read-default-float-format* 'double-float)) (cl:float (read-from-string s) 1.0d0))) (funcall (recognize (*> #'integer (opt (*> (char #\.) (take-while1 #'digit?))))) offset))

Issue: Macro call that should be transformed by fmap

Input: (fmap (lambda (s) (let ((*read-default-float-format* 'double-float)) (cl:float (read-from-string s) 1.0d0))) (funcall (recognize (*> #'integer (opt (*> (char #\.) (take-while1 #'digit?))))) offset))

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 (recognize (*> (function integer) (opt (*> (char #\FULL_STOP) (take-while1 (function digit?)))))) offset) (if (failure? res) (fail next) (values (funcall (lambda (s) (let ((*read-default-float-format* (quote double-float))) (common-lisp:float (read-from-string s) 1.0d0))) res) next)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-generic name (arg1 arg2) \"Docstring\" (:documentation \"Real docstring\"))" (first body))

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

Input: (define-generic name (arg1 arg2) \"Docstring\" (:documentation \"Real docstring\"))" (first body))

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

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

Example:

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

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

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

(prog1 (defgeneric name (arg1 arg2) (:method (arg1 arg2) |"DOCSTRING"|) (:documentation |"REAL| |DOCSTRING"|)) (setf (documentation (quote name) (quote function)) |"REAL|) (setf (documentation (fdefinition (quote name)) (quote function)) |"REAL|))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-definition-resolver method (designator package) (when (designator-generic-function-p designator) (loop for method in (sb-mop:generic-function-methods (fdefinition designator)) collect (make-instance 'method :designator designator :package package :method method))))

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

Input: (define-definition-resolver method (designator package) (when (designator-generic-function-p designator) (loop for method in (sb-mop:generic-function-methods (fdefinition designator)) collect (make-instance 'method :designator designator :package package :method method))))

Output:
(defmacro define-definition-resolver (name args &body body)
  `(progn (setf (definition-resolver ',name)
                (lambda ,args ,@body))
          ',name))

(progn (setf (definition-resolver (quote method)) (lambda (designator package) (when (designator-generic-function-p designator) (loop for method in (sb-mop:generic-function-methods (fdefinition designator)) collect (make-instance (quote method) :designator designator :package package :method method))))) (quote method))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-simple-documentation-lookup macro cl:function)

Write a macro that addresses: Macro call that should be transformed by define-simple-documentation-lookup

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

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

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


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

Problem: Macro call that should be transformed by DEFMETHOD*

Input:
(defmethod* nil
    nil)

Output: (defmacro DEFMETHOD* ...)


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

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

Input: (with-dynenv nil)

Output: (defmacro WITH-DYNENV ...)

(multiple-value-bind (#:var-expansion122 #:var-expanded-p123)
    (macroexpand-1 'var-space nil)
  (multiple-value-bind (#:fun-expansion124 #:fun-expanded-p125)
      (macroexpand-1 'fun-space nil)
    (let ((*var-space* (when #:var-expanded-p123 #:var-expansion122))
          (*fun-space* (when #:fun-expanded-p125 #:fun-expansion124))
          (*within-captured-dynenv* t)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(bind (((:flet doit (x)) "if I knew how to get the docstring out of flet, I'd test it." (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

Problem: Macro call that should be transformed by bind

Input: (bind (((:flet doit (x)) "if I knew how to get the docstring out of flet, I'd test it." (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

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))))

(flet ((doit (x) "if I knew how to get the docstring out of flet, I'd test it." (progn (setf x (* 2 x)) (setf x (+ x 3)) x))) (progn (ensure-same (doit 1) 5) (ensure-same (doit 2) 7)))


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

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

Input:
(as->* nil
  (progn))

Output: (defmacro AS->* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-disable-handler-restart (handler) (with-hook-restart (apply handler args)))

Pattern to recognize: Macro call that should be transformed by with-disable-handler-restart

Input: (with-disable-handler-restart (handler) (with-hook-restart (apply handler args)))

Output:
(defmacro with-disable-handler-restart ((handler) &body body)
  "This is intended to wrap all handler executions."
  `(restart-case
       (progn ,@body)
     (disable-handler ()
       :report
       (lambda (stream)
         (format stream "Disable handler ~a which causes the error." ,handler))
       (disable-hook *hook* ,handler))))

(restart-case (progn (with-hook-restart (apply handler args))) (disable-handler nil :report (lambda (stream) (format stream "Disable handler ~a which causes the error." handler)) (disable-hook *hook* handler)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-temp (d :directory t :debug (<= 1 *debug-prolog*)) (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `(,*yap* "-l" ,input-file ,@args) :input input :output output :error error)))

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

Input: (with-temp (d :directory t :debug (<= 1 *debug-prolog*)) (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `(,*yap* "-l" ,input-file ,@args) :input input :output output :error error)))

Output:
(defmacro with-temp ((var &key directory template (tmpdir "/tmp/") debug) &body body)
  "Create a temporary file, then remove the file by unwind-protect.
Most arguments are analogous to mktemp.
When DIRECTORY is non-nil, creates a directory instead.
DEBUG is a form.
When evaluated to non-nil, it does not remove the directory so that you can investigate what happened inside the directory.
It may be evaluated multiple times."
  (with-gensyms (command)
    `(let ((,var (uiop:run-program
                  (let ((,command (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]"
                                          ,tmpdir ,directory ,template)))
                    (when ,debug
                      (format *error-output* "~&; ~a~%" ,command))
                    ,command)
                  :output '(:string :stripped t))))
       (unwind-protect
            (progn ,@body)
         (if ,debug
             (format *error-output* "~&; not removing ~a for debugging~%" ,var)
             (uiop:run-program (format nil "rm -rf ~a" (namestring ,var)) :ignore-error-status t))))))

(let ((d (uiop/run-program:run-program (let ((#:command179 (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]" "/tmp/" t nil))) (when (<= 1 *debug-prolog*) (format *error-output* "~&; ~a~%" #:command179)) #:command179) :output (quote (:string :stripped t))))) (unwind-protect (progn (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print (sb-int:quasiquote (#S(sb-impl::comma :expr *yap* :kind 0) "-l" #S(sb-impl::comma :expr input-file :kind 0) #S(sb-impl::comma :expr args :kind 2))) :input input :output output :error error))) (if (<= 1 *debug-prolog*) (format *error-output* "~&; not removing ~a for debugging~%" d) (uiop/run-program:run-program (format nil "rm -rf ~a" (namestring d)) :ignore-error-status t))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(set-arg-list-key-value! nil :key nil)

Problem: Macro call that should be transformed by SET-ARG-LIST-KEY-VALUE!

Input: (set-arg-list-key-value! nil :key nil)

Output:
(defmacro set-arg-list-key-value! (new ids place &key (test '#'equalper) (key '#'identity))
  `(progn
    (iter (for id in (ensure-list ,ids))
      (setf ,place (set-arg-list-key-value ,new id ,place :test ,test :key ,key)))
    ,place))

(progn
 (iter
   (for id in (ensure-list :key))
   (setf nil
           (set-arg-list-key-value nil id nil :test #'equalper :key
                                   #'identity)))
 nil)


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

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

Input: (-<> 'some-name)

Output: (defmacro -<> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-method-combination% standard () ((around (:around)) (before (:before)) (primary () :required t) (after (:after) :order :most-specific-last)) (labels ((call-methods (methods) (mapcar (curry #'list 'call-method) methods)) (call-primary (primary) `(call-method ,(first primary) ,(rest primary))) (call-before (before form) (if before `(progn ,@(call-methods before) ,form) form)) (call-after (after form) (if after `(multiple-value-prog1 ,form ,@(call-methods after)) form)) (call-around (around form) (if around `(call-method ,(first around) (,@(rest around) (make-method ,form))) form))) (->> (call-primary primary) (call-before before) (call-after after) (call-around around))))

Pattern to recognize: Macro call that should be transformed by define-method-combination%

Input: (define-method-combination% standard () ((around (:around)) (before (:before)) (primary () :required t) (after (:after) :order :most-specific-last)) (labels ((call-methods (methods) (mapcar (curry #'list 'call-method) methods)) (call-primary (primary) `(call-method ,(first primary) ,(rest primary))) (call-before (before form) (if before `(progn ,@(call-methods before) ,form) form)) (call-after (after form) (if after `(multiple-value-prog1 ,form ,@(call-methods after)) form)) (call-around (around form) (if around `(call-method ,(first around) (,@(rest around) (make-method ,form))) form))) (->> (call-primary primary) (call-before before) (call-after after) (call-around around))))

Output:
(defmacro define-method-combination% (name &rest args)
  "Define a method-combination for the static-dispatch system only.

   Arguments are of the same form as to CL:DEFINE-METHOD-COMBINATION."

  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (combination-function ',name)
      ,(match args
         ((or nil
              (list* (and (type symbol) (not nil)) _))

          (destructuring-bind (&key (operator name) (identity-with-one-argument nil))
              args

            `(method-combination-function-short ,name ,operator ,identity-with-one-argument)))

         (_
          `(method-combination-function ,name ,@args))))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (combination-function (quote standard)) (method-combination-function standard nil ((around (:around)) (before (:before)) (primary nil :required t) (after (:after) :order :most-specific-last)) (labels ((call-methods (methods) (mapcar (curry (function list) (quote call-method)) methods)) (call-primary (primary) (sb-int:quasiquote (call-method #S(sb-impl::comma :expr (first primary) :kind 0) #S(sb-impl::comma :expr (rest primary) :kind 0)))) (call-before (before form) (if before (sb-int:quasiquote (progn #S(sb-impl::comma :expr (call-methods before) :kind 2) #S(sb-impl::comma :expr form :kind 0))) form)) (call-after (after form) (if after (sb-int:quasiquote (multiple-value-prog1 #S(sb-impl::comma :expr form :kind 0) #S(sb-impl::comma :expr (call-methods after) :kind 2))) form)) (call-around (around form) (if around (sb-int:quasiquote (call-method #S(sb-impl::comma :expr (first around) :kind 0) (#S(sb-impl::comma :expr (rest around) :kind 2) (make-method #S(sb-impl::comma :expr form :kind 0))))) form))) (->> (call-primary primary) (call-before before) (call-after after) (call-around around))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(macroexpand-convention (form) (destructuring-case form ((progn &body body) `(progn ,@(apply-at-macro-to-multiple-forms at-macro-form body))) ((eval-when situations &body body) `(eval-when ,situations ,@(apply-at-macro-to-multiple-forms at-macro-form body))) ((locally &body body) (multiple-value-bind (body declarations) (parse-body body) `(locally ,@declarations ,@(apply-at-macro-to-multiple-forms at-macro-form body)))) (((macrolet symbol-macrolet) bindings &body body) (multiple-value-bind (body declarations) (parse-body body) `(,(first form) ,bindings ,@declarations ,@(apply-at-macro-to-multiple-forms at-macro-form body)))) ((otherwise &rest _) (declare (ignore _)) form)))

Issue: Macro call that should be transformed by macroexpand-convention

Input: (macroexpand-convention (form) (destructuring-case form ((progn &body body) `(progn ,@(apply-at-macro-to-multiple-forms at-macro-form body))) ((eval-when situations &body body) `(eval-when ,situations ,@(apply-at-macro-to-multiple-forms at-macro-form body))) ((locally &body body) (multiple-value-bind (body declarations) (parse-body body) `(locally ,@declarations ,@(apply-at-macro-to-multiple-forms at-macro-form body)))) (((macrolet symbol-macrolet) bindings &body body) (multiple-value-bind (body declarations) (parse-body body) `(,(first form) ,bindings ,@declarations ,@(apply-at-macro-to-multiple-forms at-macro-form body)))) ((otherwise &rest _) (declare (ignore _)) form)))

Output:
(defmacro macroexpand-convention ((original-form) &body body)
  "Executes BODY as like `progn' and return the result as the first
value.  As the second value, returns a boolean whether the result is
not same with ORIGINAL-FORM or not.
This macro is designed to follow the `macroexpand' convention."
  `(multiple-value-bind (result expanded-p)
       (progn ,@body)
     (values result
             (or expanded-p
                 (not (eq result ,original-form))))))

(multiple-value-bind (result expanded-p) (progn (destructuring-case form ((progn &body body) (sb-int:quasiquote (progn #S(sb-impl::comma :expr (apply-at-macro-to-multiple-forms at-macro-form body) :kind 2)))) ((eval-when situations &body body) (sb-int:quasiquote (eval-when #S(sb-impl::comma :expr situations :kind 0) #S(sb-impl::comma :expr (apply-at-macro-to-multiple-forms at-macro-form body) :kind 2)))) ((locally &body body) (multiple-value-bind (body declarations) (parse-body body) (sb-int:quasiquote (locally #S(sb-impl::comma :expr declarations :kind 2) #S(sb-impl::comma :expr (apply-at-macro-to-multiple-forms at-macro-form body) :kind 2))))) (((macrolet symbol-macrolet) bindings &body body) (multiple-value-bind (body declarations) (parse-body body) (sb-int:quasiquote (#S(sb-impl::comma :expr (first form) :kind 0) #S(sb-impl::comma :expr bindings :kind 0) #S(sb-impl::comma :expr declarations :kind 2) #S(sb-impl::comma :expr (apply-at-macro-to-multiple-forms at-macro-form body) :kind 2))))) ((otherwise &rest _) (declare (ignore _)) form))) (values result (or expanded-p (not (eq result form)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(builder (:session :store (make-redis-store :namespace *namespace* :connection *connection*)) (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session))))))))

Problem: Macro call that should be transformed by builder

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

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 (#:app240) (funcall (find-middleware :session) #:app240 :store (make-redis-store :namespace *namespace* :connection *connection*))))) :initial-value (to-app (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) (sb-int:quasiquote (200 (:content-type "text/plain") (#S(sb-impl::comma :expr (format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session)))) :kind 0)))))) :from-end t)


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

Problem: Macro call that should be transformed by DEFMETHOD*

Input: (defmethod* 'some-name)

Output: (defmacro DEFMETHOD* ...)

(let* ((#:some-name131 (ensure-generic*-function ''some-name))
       (temp-method (defmethod #:some-name130))
       (actual-gf
        (ensure-generic*-function ''some-name :lambda-list
                                  (sb-mop:generic-function-lambda-list
                                   (symbol-function '#:some-name130))
                                  :special-variables 'nil))
       (actual-method
        (add-method* #:some-name131
                     (make-instance 'method* :special-variables (list)
                                    :qualifiers 'nil :specializers
                                    (sb-mop:method-specializers temp-method)
                                    :lambda-list
                                    (sb-mop:method-lambda-list temp-method)
                                    :documentation
                                    (documentation temp-method t) :function
                                    (sb-mop:method-function temp-method)))))
  (declare (ignorable #:some-name131)
           (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:
(var 'some-name)

Problem: Macro call that should be transformed by VAR

Input: (var 'some-name)

Output: (defmacro VAR ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(continue-whopper nil (progn))

Issue: Macro call that should be transformed by CONTINUE-WHOPPER

Input: (continue-whopper nil (progn))

Output: (defmacro CONTINUE-WHOPPER ...)

(call-next-method-fn self class-env inst-env mcs%caller mcs%next-methods
                     (list nil (progn)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
;; eval loses lexical environment - can't access surrounding bindings
(let ((x 1))
  (eval '(+ 1 x)))  ;; Error: X is unbound!

;; Need: way to tunnel lexical variables into eval

What needs to change: eval cannot access lexical environment — want a 'tunnel' that bridges lexical scope into eval's dynamic world

Input:
;; eval loses lexical environment - can't access surrounding bindings
(let ((x 1))
  (eval '(+ 1 x)))  ;; Error: X is unbound!

;; Need: way to tunnel lexical variables into eval

Output:
(defvar pandoric-eval-tunnel)

(defmacro pandoric-eval (vars expr)
  `(let ((pandoric-eval-tunnel
           (plambda () ,vars t)))
     (eval `(with-pandoric
              ,',vars pandoric-eval-tunnel
              ,,expr))))

;; (let ((x 1))
;;   (pandoric-eval (x)
;;     '(+ 1 x)))
;; => 2
;;
;; (let ((x 1))
;;   (pandoric-eval (x)
;;     '(incf x))
;;   x)
;; => 2  ;; modifications persist!
;;
;; Builds a plambda capturing x, then eval-with-pandoric
;; reconstructs x as symbol-macrolet inside eval


Instruction:
Write a Common Lisp macro to handle this code pattern:
(without-c-dependency (tv))

Problem: Macro call that should be transformed by without-c-dependency

Input: (without-c-dependency (tv))

Output:
(defmacro without-c-dependency (&body body)
  ` (let (*depender*)
      ,@body))


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

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

Input: (js nil nil)

Output: (defmacro JS ...)


Instruction:
Generate a defmacro form that transforms code like this:
(ematch0 args (nil nil) ((list* '&optional rest) (list* '&optional (process-optional-args rest))) ((list* '&key rest) (list* '&key (process-keyword-args rest))) ((list* '&rest rest) (list* '&rest (process-rest-args rest))) ((list* '&aux rest) args) ((list* thing rest) (list* thing (process-lambda-args rest))))

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

Input: (ematch0 args (nil nil) ((list* '&optional rest) (list* '&optional (process-optional-args rest))) ((list* '&key rest) (list* '&key (process-keyword-args rest))) ((list* '&rest rest) (list* '&rest (process-rest-args rest))) ((list* '&aux rest) args) ((list* thing rest) (list* thing (process-lambda-args rest))))

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

(match0 args (nil nil) ((list* (quote &optional) rest) (list* (quote &optional) (process-optional-args rest))) ((list* (quote &key) rest) (list* (quote &key) (process-keyword-args rest))) ((list* (quote &rest) rest) (list* (quote &rest) (process-rest-args rest))) ((list* (quote &aux) rest) args) ((list* thing rest) (list* thing (process-lambda-args rest))) (_ (error "level0 match error!")))


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

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

Input: (with-special-initargs 'some-name)

Output: (defmacro WITH-SPECIAL-INITARGS ...)

(funcall-with-special-initargs (list (list . quote) (list . some-name))
                               (lambda ()))


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

Issue: Macro call that should be transformed by DEFPROTO

Input: (defproto nil (progn))

Output: (defmacro DEFPROTO ...)

(progn
 (declaim (special nil))
 (eval-when (:compile-toplevel))
 (setf (symbol-value 'nil)
         (ensure-object (when (boundp 'nil) (symbol-value 'nil)) (list progn)
                        :properties (list) :nickname 'nil)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (eql (top-sign) 'skip-first-list-init) (pop-sign))

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

Input: (when (eql (top-sign) 'skip-first-list-init) (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-list-init)) (pop-sign))


Instruction:
Generate a defmacro form that transforms code like this:
(with-active-layers 'some-name)

Pattern to recognize: Macro call that should be transformed by WITH-ACTIVE-LAYERS

Input: (with-active-layers 'some-name)

Output: (defmacro WITH-ACTIVE-LAYERS ...)

(dynamic-wind
  :proceed
  #:proceed182
  (%with-active-layers 'some-name
    (#:proceed182)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-definition-resolver symbol-macro (designator) (sb-int:info :variable :macro-expansion designator))

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

Input: (define-simple-definition-resolver symbol-macro (designator) (sb-int:info :variable :macro-expansion designator))

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

(define-definition-resolver symbol-macro (symbol-macro #:package146) (when (ignore-errors (let ((designator symbol-macro)) (sb-int:info :variable :macro-expansion designator))) (list (make-instance (quote symbol-macro) :designator symbol-macro :package #:package146))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(deferror "42704" unrecognized-configuration-parameter data-exception)

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

Input: (deferror "42704" unrecognized-configuration-parameter data-exception)

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

(progn (define-condition unrecognized-configuration-parameter (data-exception) nil) (setf (gethash "42704" *error-table*) (quote unrecognized-configuration-parameter)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(answer foo 23)

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

Input: (answer foo 23)

Output:
(defmacro answer (call &body forms)
  (let ((name (if (listp call) (car call) call))
        (sym (gensym)))
    `(if-called
      ',name
      (let ((,sym (fdefinition ',name)))
        (declare (ignorable ,sym))
        (let ((times 0))
          (lambda (&rest args)
            (declare (ignorable args))
            ,(let ((cases
                     `(case (prog1 times (incf times))
                        ,.(loop
                            for i from 0
                            for (form . rest) on forms
                            collect `(,(if rest i T) ,form)))))
               (if (listp call)
                   `(trivia:match args
                     ((list . ,(cdr call)) ,cases)
                     (_ (unhandled)))
                   cases))))))))

(if-called (quote foo) (let ((#:g159 (fdefinition (quote foo)))) (declare (ignorable #:g159)) (let ((times 0)) (lambda (&rest args) (declare (ignorable args)) (case (prog1 times (incf times)) (t 23))))))


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

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

Input:
(dreletf nil
  nil)

Output: (defmacro DRELETF ...)

(let ((#:symbol-store232
       (with-symbol-access
         (list))))
  (special-symbol-reprogv #:symbol-store232
      (list)
    (locally (declare (special)) nil)))


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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(make-simple-collector-to-place 'some-name)

Problem: Macro call that should be transformed by MAKE-SIMPLE-COLLECTOR-TO-PLACE

Input: (make-simple-collector-to-place 'some-name)

Output: (defmacro MAKE-SIMPLE-COLLECTOR-TO-PLACE ...)

(progn
 (setf 'some-name (alexandria:ensure-list 'some-name))
 (let* ((#:tail124 (last 'some-name)))
   (lambda (&rest values)
     (collect-at-end 'some-name #:tail124 values)
     'some-name)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(any-of nil
  (progn))

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

Input:
(any-of nil
  (progn))

Output: (defmacro ANY-OF ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'init-accumulator :array-member #'accumulator-add :end-of-array #'accumulator-get-sequence :array-type 'list :beginning-of-object #'init-accumulator :object-key #'accumulator-add-key :object-value #'accumulator-add-value :end-of-object #'accumulator-get :beginning-of-string #'init-string-stream-accumulator :string-char #'string-stream-accumulator-add :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :internal-decoder #'decode-json)

What needs to change: Macro call that should be transformed by set-custom-vars

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(dynamic-let* nil)

Issue: Macro call that should be transformed by DYNAMIC-LET*

Input: (dynamic-let* nil)

Output: (defmacro DYNAMIC-LET* ...)