Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause list-tails (&whole form list &key (by '(function cdr)) &environment env) "Loops over the successive tails of a list, checking for the end of the list as if by ATOM. Can perform destructuring." (if (symbolp *iteration-variable*) (let ((g (gensym))) (list (make-simple-iteration :var *iteration-variable* :init list :step `(funcall ,by ,*iteration-variable*)) (make-simple-iteration :var g :init nil :step nil :precondition `(not (atom ,*iteration-variable*))))) (expand-with-simple-destructuring form env)))

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

Input: (defclause list-tails (&whole form list &key (by '(function cdr)) &environment env) "Loops over the successive tails of a list, checking for the end of the list as if by ATOM. Can perform destructuring." (if (symbolp *iteration-variable*) (let ((g (gensym))) (list (make-simple-iteration :var *iteration-variable* :init list :step `(funcall ,by ,*iteration-variable*)) (make-simple-iteration :var g :init nil :step nil :precondition `(not (atom ,*iteration-variable*))))) (expand-with-simple-destructuring form env)))

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

(progn (defmacro list-tails (&whole form list &key (by (quote (function cdr))) &environment env) "Loops over the successive tails of a list, checking for the end of the list as if by ATOM. Can perform destructuring." (if (symbolp *iteration-variable*) (let ((g (gensym))) (list (make-simple-iteration :var *iteration-variable* :init list :step (sb-int:quasiquote (funcall #S(sb-impl::comma :expr by :kind 0) #S(sb-impl::comma :expr *iteration-variable* :kind 0)))) (make-simple-iteration :var g :init nil :step nil :precondition (sb-int:quasiquote (not (atom #S(sb-impl::comma :expr *iteration-variable* :kind 0))))))) (expand-with-simple-destructuring form env))) (pushnew (quote list-tails) *clauses*))


Instruction:
Generate a defmacro form that transforms code like this:
(is (= 2 (length (remove-if-not #'test-passed-p results))))

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

Input: (is (= 2 (length (remove-if-not #'test-passed-p 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 ((#:e238 2) (#:a239 (length (remove-if-not (function test-passed-p) results)))) (if (progn (= #:e238 #:a239)) (add-result (quote test-passed) :test-expr (quote (= 2 (length (remove-if-not (function test-passed-p) results))))) (process-failure (quote (= 2 (length (remove-if-not (function test-passed-p) results)))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (length (remove-if-not (function test-passed-p) results))) #:a239 (quote =) #:e238)))


Instruction:
Generate a defmacro form that transforms code like this:
(match list ((list x) (if (oddp x) x (fail))))

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

Input: (match list ((list x) (if (oddp x) x (fail))))

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

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

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

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

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

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

will be translated to

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

Examples:

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

(%or (%if (consp list) (let ((#:g144 (car list)) (#:g145 (cdr list))) (declare (ignorable #:g144 #:g145)) (%if (%equals #:g145 nil) (%or (let ((x #:g144)) (if (oddp x) x (fail))) (fail)) (fail))) (fail)) nil)


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

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

Input: (->> nil)

Output: (defmacro ->> ...)


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

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

Input: (dict-of nil (progn))

Output: (defmacro DICT-OF ...)

(let ((#:dict128 (make-hash-table :test 'equal)))
  (do-for ((progn))
    (multiple-value-call
        (lambda (#:k129 #:v130) (setf (gethash #:k129 #:dict128) #:v130))
      nil))
  #:dict128)


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

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

Input:
(with-properties nil
    :key
  nil)

Output: (defmacro WITH-PROPERTIES ...)

(let ((#:g135 :key))
  (symbol-macrolet ()
    nil))


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

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

Input: (defprotocol nil)

Output: (defmacro DEFPROTOCOL ...)

(progn
 (progn
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (%build-protocol-object (%ensure-protocol-compilation-note 'nil) 'nil)
    (defun nil-p (object)
      #A((29) base-char . "test if object implements NIL")
      (implements-protocol? object (ensure-protocol 'nil)))
    (deftype nil () nil '(satisfies nil-p)))
  (let ((#:g131 (ensure-protocol 'nil)))
    (%build-protocol-object #:g131 'nil)
    (setf (protocol-includes-generic-pun #:g131) nil
          (protocol-includes-method-pun #:g131) nil))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-custom-var (:object-key *object-key-handler*) (constantly t) "Designator for a function of 1 string argument (decoded member key of Object).")

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

Input: (define-custom-var (:object-key *object-key-handler*) (constantly t) "Designator for a function of 1 string argument (decoded member key of Object).")

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*object-key-handler* . :object-key)) *custom-vars* :test (function equal)) (defvar *object-key-handler* (constantly t) "Designator for a function of 1 string argument (decoded member key of Object).")))


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

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

Input: (dlet* nil)

Output: (defmacro DLET* ...)


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

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

Input: (make-instance* 'class (a b c))

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

Conveniences:

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

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

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

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

Examples:

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

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

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

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

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

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

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

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

(apply (function make-instance) (quote class) (a b c))


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

What needs to change: Macro call that should be transformed by DO-ALL-NAMESPACES

Input: (do-all-namespaces 'some-name)

Output: (defmacro DO-ALL-NAMESPACES ...)

(do-namespace (namespace _ quote some-name))


Instruction:
Define a macro that eliminates this repetitive pattern:
(-> (from :users) (when include-inactive (where (:= :active 0))) (when sort-by-date (order-by :created_at)))

Issue: Macro call that should be transformed by ->

Input: (-> (from :users) (when include-inactive (where (:= :active 0))) (when sort-by-date (order-by :created_at)))

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-var147 (from :users)) (#:threaded-var147 (typecase #:threaded-var147 (query-state-base (copy-query-state-immutable #:threaded-var147)) (stmt:select-statement (select-statement-to-query-state #:threaded-var147)) (stmt:insert-into-statement (insert-statement-to-query-state #:threaded-var147)) (stmt:update-statement (update-statement-to-query-state #:threaded-var147)) (stmt:delete-from-statement (delete-statement-to-query-state #:threaded-var147)) (otherwise (add-clause (make-select-query-state) #:threaded-var147))))) (let ((#:clause-var148 (when include-inactive (where (:= :active 0))))) (when #:clause-var148 (add-clause #:threaded-var147 #:clause-var148))) (let ((#:clause-var148 (when sort-by-date (order-by :created_at)))) (when #:clause-var148 (add-clause #:threaded-var147 #:clause-var148))) #:threaded-var147)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(if-let ((x 1) (y nil)) :oops (and (not y) x))

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

Input: (if-let ((x 1) (y nil)) :oops (and (not y) x))

Output:
(defmacro if-let (bindings &body (then-form &optional else-form))
    "Creates new variable bindings, and conditionally executes either
THEN-FORM or ELSE-FORM. ELSE-FORM defaults to NIL.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

 ((variable-1 initial-form-1)
  (variable-2 initial-form-2)
  ...
  (variable-n initial-form-n))

All initial-forms are executed sequentially in the specified order. Then all
the variables are bound to the corresponding values.

If all variables were bound to true values, the THEN-FORM is executed with the
bindings in effect, otherwise the ELSE-FORM is executed with the bindings in
effect."
    (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
                             (list bindings)
                             bindings))
         (variables (mapcar #'car binding-list)))
    `(let ,binding-list
       (if (and ,@variables)
           ,then-form
           ,else-form))))

(let ((x 1) (y nil)) (if (and x y) :oops (and (not y) x)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(subtest "Outer testcase with multiline description." (is 'blah 'blah "Blah with multiline description!") (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 "Outer testcase with multiline description." (is 'blah 'blah "Blah with multiline description!") (subtest "Inner testcase with multiline description." (is 'foo 'foo "Foo with multiline description!")))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-op (:union conjunctive-op))

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

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

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

(defstruct (union-op (:include conjunctive-op (name "UNION")) (:constructor make-union-op (&rest expressions))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(def-neo4j-fun del-node-property (node-id property) :delete (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (204 (values t body)) (404 (error 'node-not-found-error :uri uri)) (409 (error 'unable-to-delete-node-error :uri uri))))

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

Input: (def-neo4j-fun del-node-property (node-id property) :delete (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (204 (values t body)) (404 (error 'node-not-found-error :uri uri)) (409 (error 'unable-to-delete-node-error :uri uri))))

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

(progn (defun del-node-property (&key node-id property) (let ((uri (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :delete uri json (list (list 204 (lambda (body uri json) (values t body))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))) (list 409 (lambda (body uri json) (error (quote unable-to-delete-node-error) :uri uri))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> +underscore+ +digit-chunks+)

Issue: Macro call that should be transformed by *>

Input: (*> +underscore+ +digit-chunks+)

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

(lambda (#:*>-offset242) (multiple-value-bind (#:*>-res243 #:*>-next244) (funcall +underscore+ #:*>-offset242) (if (ok? #:*>-res243) (funcall +digit-chunks+ #:*>-next244) (fail #:*>-next244))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-decoder-simple-list-semantics (let* ((error (eq output-value :error)) (expected (cond ((eq output-value :error) nil) (t (with-guessing-encoder (encode-json-to-string output-value))))) (input-encoded (with-guessing-encoder (encode-json-to-string input-value))) (result (handler-bind ((error #'(lambda (x) (invoke-restart 'json-rpc:send-error (format nil "~a" x) 999)))) (json-rpc:invoke-rpc (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"method\":\"fooA\",\"params\":[~a],\"id\":999}" (json-rpc-2-p) input-encoded))))) (if error (let ((res (decode-json-from-string result))) (is (and (null (cdr (assoc :result res))) (cdr (assoc :error res))))) (is (string= result (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"result\":~a,~@[~*\"error\":null,~]\"id\":999}" (json-rpc-2-p) expected (not (json-rpc-2-p))))))))

Write a macro that addresses: Macro call that should be transformed by with-decoder-simple-list-semantics

Input: (with-decoder-simple-list-semantics (let* ((error (eq output-value :error)) (expected (cond ((eq output-value :error) nil) (t (with-guessing-encoder (encode-json-to-string output-value))))) (input-encoded (with-guessing-encoder (encode-json-to-string input-value))) (result (handler-bind ((error #'(lambda (x) (invoke-restart 'json-rpc:send-error (format nil "~a" x) 999)))) (json-rpc:invoke-rpc (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"method\":\"fooA\",\"params\":[~a],\"id\":999}" (json-rpc-2-p) input-encoded))))) (if error (let ((res (decode-json-from-string result))) (is (and (null (cdr (assoc :result res))) (cdr (assoc :error res))))) (is (string= result (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"result\":~a,~@[~*\"error\":null,~]\"id\":999}" (json-rpc-2-p) expected (not (json-rpc-2-p))))))))

Output:
(defmacro with-decoder-simple-list-semantics (&body body)
  "Execute BODY in a dynamic environement where the decoder semantics
is such as set by SET-DECODER-SIMPLE-LIST-SEMANTICS."
  `(with-shadowed-custom-vars
     (set-decoder-simple-list-semantics)
     ,@body))

(with-shadowed-custom-vars (set-decoder-simple-list-semantics) (let* ((error (eq output-value :error)) (expected (cond ((eq output-value :error) nil) (t (with-guessing-encoder (encode-json-to-string output-value))))) (input-encoded (with-guessing-encoder (encode-json-to-string input-value))) (result (handler-bind ((error (function (lambda (x) (invoke-restart (quote json-rpc:send-error) (format nil "~a" x) 999))))) (json-rpc:invoke-rpc (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"method\":\"fooA\",\"params\":[~a],\"id\":999}" (json-rpc-2-p) input-encoded))))) (if error (let ((res (decode-json-from-string result))) (is (and (null (cdr (assoc :result res))) (cdr (assoc :error res))))) (is (string= result (format nil "{~@[~*\"jsonrpc\":\"2.0\",~]\"result\":~a,~@[~*\"error\":null,~]\"id\":999}" (json-rpc-2-p) expected (not (json-rpc-2-p))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(lret ((x 1)) (setf x 2))

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

Input: (lret ((x 1)) (setf x 2))

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:html (:head (:link #p"styles.css" :type "text/css"))))

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

Input: (with-html-string (:html (:head (:link #p"styles.css" :type "text/css"))))

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 (:html (:head (:link #P"styles.css" :type "text/css")))))


Instruction:
Generate a defmacro form that transforms code like this:
($map-reduce "foo" m r :query ($> "l" -9))

Pattern to recognize: Macro call that should be transformed by $map-reduce

Input: ($map-reduce "foo" m r :query ($> "l" -9))

Output:
(defmacro $map-reduce (collection map reduce &key (query nil) (limit 0) (out nil)
		       (keeptemp nil) (finalize nil) (verbose t))
  "Run map reduce on the mongo server. map and reduce are either the names of the
javascript functions, created with defjs or defsrvjs or are function definitions in javascript.
The keywords refer to option available for map reduce in mongo. This returns a result summary document.
When using :keeptemp t without specificing :out the collection is mr.<collection> "
    `(db.find "$cmd" (kv (kv "mapreduce" ,collection)
			 (kv "map"    (or (jsdef ,map) ',map))
			 (kv "reduce" (or (jsdef ,reduce) ',reduce))
			 (when ,finalize (kv "finalize" (jsdef ,finalize)))
			 (kv "out"      (if ,out ,out (concatenate 'string "mr." ,collection)))
			 (kv "verbose"  ,verbose)
			 (kv "limit"    ,limit)
			 (kv "keeptemp" ,keeptemp)
			 (kv "query"    ,query))))

(db.find "$cmd" (kv (kv "mapreduce" "foo") (kv "map" (or (jsdef m) (quote m))) (kv "reduce" (or (jsdef r) (quote r))) (when nil (kv "finalize" (jsdef nil))) (kv "out" (if nil nil (concatenate (quote string) "mr." "foo"))) (kv "verbose" t) (kv "limit" 0) (kv "keeptemp" nil) (kv "query" ($> "l" -9))))


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

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

Input: (defgeneric* nil nil)

Output: (defmacro DEFGENERIC* ...)

(ensure-generic*-function 'nil :name 'nil :lambda-list 'nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-wcs-math-error-handling (ret (tan x)) (check-wcs-math-result))

What needs to change: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling (ret (tan x)) (check-wcs-math-result))

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

(let* ((#:g215 x) (#:g216 nil) (#:g217 (list #:g215))) (declare (ignorable #:g216) (type list #:g217) (dynamic-extent #:g217)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote tan) #:g217) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g217)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-generic generic ((a a) (b b) &key (c nil)) "This expands to documentation." (+ a b))

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

Input: (define-generic generic ((a a) (b b) &key (c nil)) "This expands to documentation." (+ a b))

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 generic (a b &key c) (:method ((a a) (b b) &key (c nil)) (+ a b)) (:documentation "This expands to documentation.")) (setf (documentation (quote generic) (quote function)) "This expands to documentation.") (setf (documentation (fdefinition (quote generic)) (quote function)) "This expands to documentation."))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-transaction *db* (do-sql *db* "INSERT INTO person (id, name) VALUES (4, 'meymao')"))

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

Input: (with-transaction *db* (do-sql *db* "INSERT INTO person (id, name) VALUES (4, 'meymao')"))

Output:
(defmacro with-transaction (conn &body body)
  "Start a transaction and commit at the end of this block. If the evaluation `body` is interrupted, the transaction is rolled back automatically."
  (let ((conn-var (gensym "CONN-VAR")))
    `(let ((,conn-var ,conn))
       (if (in-transaction ,conn-var)
           (with-savepoint ,conn-var ,@body)
           (%with-transaction ,conn-var ,@body)))))

(let ((#:conn-var160 *db*)) (if (in-transaction #:conn-var160) (with-savepoint #:conn-var160 (do-sql *db* "INSERT INTO person (id, name) VALUES (4, 'meymao')")) (%with-transaction #:conn-var160 (do-sql *db* "INSERT INTO person (id, name) VALUES (4, 'meymao')"))))


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

Issue: Macro call that should be transformed by ->

Input: (-> :g () 3)

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(defalias path:rm-r (pathname) cl-fad:delete-directory-and-files)

Issue: Macro call that should be transformed by defalias

Input: (defalias path:rm-r (pathname) cl-fad:delete-directory-and-files)

Output:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

(progn (defun path:rm-r (pathname) (delete-directory-and-files pathname)) (define-compiler-macro path:rm-r (&rest args) (list* (quote delete-directory-and-files) args)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(let1 x 1 (list y z))

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

Input: (let1 x 1 (list y z))

Output:
(defmacro let1 (var expr &body body)
  "Bind VAR, immutably, to EXPR and evaluate BODY.

This may be pronounced with equal propriety as \"let-one\" or
\"let-once\"."
  `(let ((,var ,expr))
     (with-read-only-vars (,var)
       ,@body)))

(let ((x 1)) (with-read-only-vars (x) (list y z)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-binary-op-mapping-definer define-binary-ops `(progn (declaim (inline ,op)) (defun ,op (x y) (,cl x y))))

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

Input: (define-binary-op-mapping-definer define-binary-ops `(progn (declaim (inline ,op)) (defun ,op (x y) (,cl x y))))

Output:
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

(defmacro define-binary-ops (&rest map) (sb-int:quasiquote (progn #S(sb-impl::comma :expr (loop for (vacietis cl) on map by (function cddr) collect (let ((op (find-symbol (symbol-name vacietis) (quote #:vacietis.c)))) (sb-int:quasiquote (progn (declaim (inline #S(sb-impl::comma :expr op :kind 0))) (defun #S(sb-impl::comma :expr op :kind 0) (x y) (#S(sb-impl::comma :expr cl :kind 0) x y)))))) :kind 2))))


Instruction:
Generate a defmacro form that transforms code like this:
(cond-> nil :key nil)

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

Input: (cond-> nil :key nil)

Output: (defmacro COND-> ...)


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

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

Input: (some-> 'some-name)

Output: (defmacro SOME-> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(c-assert (listp new-kids) () "New kids value for ~a not listp: ~a ~a" self (type-of new-kids) new-kids)

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

Input: (c-assert (listp new-kids) () "New kids value for ~a not listp: ~a ~a" self (type-of new-kids) new-kids)

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

(unless *stop* (unless (listp new-kids) (c-break "New kids value for ~a not listp: ~a ~a" self (type-of new-kids) new-kids)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-variable node bound-variables) (let ((name (node-variable-value node))) (unless (member name bound-variables :test #'eq) (alexandria:when-let ((target (alias-substitution-target name aliases))) (copy-node target (node-type node))))))

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

Input: (action (:after node-variable node bound-variables) (let ((name (node-variable-value node))) (unless (member name bound-variables :test #'eq) (alexandria:when-let ((target (alias-substitution-target name aliases))) (copy-node target (node-type node))))))

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

(make-action (quote :after) (quote node-variable) (lambda (node bound-variables) (declare (type node-variable node)) (let ((name (node-variable-value node))) (unless (member name bound-variables :test (function eq)) (alexandria:when-let ((target (alias-substitution-target name aliases))) (copy-node target (node-type node)))))))


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

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

Input: (collect-sum 'some-name)

Output: (defmacro COLLECT-SUM ...)

(common-lisp:let* ((#:generator-242 (generator 'some-name))
                   #:numbers-238
                   (#:sum-239 0))
  (declare (type generator #:generator-242)
           (type number #:sum-239))
  (tagbody
   #:ll-243
    (setq #:numbers-238 (next-in #:generator-242 (go end)))
    (setq #:sum-239 (+ #:sum-239 #:numbers-238))
    (go #:ll-243)
   end)
  #:sum-239)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defannotation export* (definition-form) (:alias export) "Export the definition symbol of DEFINITION-FORM." (let ((name (definition-form-symbol definition-form))) (if name `(progn (export ',name) ,definition-form) definition-form)))

Issue: Macro call that should be transformed by defannotation

Input: (defannotation export* (definition-form) (:alias export) "Export the definition symbol of DEFINITION-FORM." (let ((name (definition-form-symbol definition-form))) (if name `(progn (export ',name) ,definition-form) definition-form)))

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

(progn (set-annotation-options (quote export*) (quote (:alias export))) (defmacro export* (definition-form) "Export the definition symbol of DEFINITION-FORM." (let ((name (definition-form-symbol definition-form))) (if name (sb-int:quasiquote (progn (export (quote #S(sb-impl::comma :expr name :kind 0))) #S(sb-impl::comma :expr definition-form :kind 0))) definition-form))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(lret* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)

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

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

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* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when-it (remove-if-not #'internal-variable? (free-variables form)) (clause-error "The variable~p ~{~A~^, ~} ~:[is~;are~] bound in a context ~ internal to the Iterate form.~% This part of the clause will be moved outside ~ the body of the loop, so it must not contain anything that depends on the body." (length it) it (rest it)))

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

Input: (when-it (remove-if-not #'internal-variable? (free-variables form)) (clause-error "The variable~p ~{~A~^, ~} ~:[is~;are~] bound in a context ~ internal to the Iterate form.~% This part of the clause will be moved outside ~ the body of the loop, so it must not contain anything that depends on the body." (length it) it (rest it)))

Output:
(defmacro when-it (test &body body)
  "Like WHEN. IT is bound to TEST."
  `(let ((it ,test))
     (when it
       ,@body)))

(let ((it (remove-if-not (function internal-variable?) (free-variables form)))) (when it (clause-error "The variable~p ~{~A~^, ~} ~:[is~;are~] bound in a context ~ internal to the Iterate form.~% This part of the clause will be moved outside ~ the body of the loop, so it must not contain anything that depends on the body." (length it) it (rest it))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(caching-types
  nil)

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

Input:
(caching-types
  nil)

Output: (defmacro CACHING-TYPES ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-color (color :stream stream) (format stream "(~Dms)" duration))

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

Input: (with-color (color :stream stream) (format stream "(~Dms)" duration))

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

(if *enable-colors* (if (or (eq color :gray) (eq color :grey) (eq color +gray+) (eq color +grey+)) (with-gray stream (format stream "(~Dms)" duration)) (cl-ansi-text:with-color (color :stream stream) (format stream "(~Dms)" duration))) (progn (format stream "(~Dms)" duration)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-dynenv nil
  (progn))

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

Input:
(with-dynenv nil
  (progn))

Output: (defmacro WITH-DYNENV ...)

(multiple-value-bind (#:var-expansion130 #:var-expanded-p131)
    (macroexpand-1 'var-space nil)
  (multiple-value-bind (#:fun-expansion132 #:fun-expanded-p133)
      (macroexpand-1 'fun-space nil)
    (let ((*var-space* (when #:var-expanded-p131 #:var-expansion130))
          (*fun-space* (when #:fun-expanded-p133 #:fun-expansion132))
          (*within-captured-dynenv* t))
      (progn))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (oddp (length rest)) (error "Set operator with odd number of elements: ~a" rest))

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

Input: (when (oddp (length rest)) (error "Set operator with odd number of elements: ~a" rest))

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

(if (oddp (length rest)) (error "Set operator with odd number of elements: ~a" rest))


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

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

Input:
(dreletf nil
  (progn))

Output: (defmacro DRELETF ...)

(let ((#:symbol-store233
       (with-symbol-access
         (list))))
  (special-symbol-reprogv #:symbol-store233
      (list)
    (locally (declare (special)) (progn))))


Instruction:
Generate a defmacro form that transforms code like this:
(mvlet* ((slot-names slot-binds (loop for slot in slots if (listp slot) collect slot into slot-binds and collect (first slot) into slot-names else collect slot into slot-names and collect (list slot slot) into slot-binds finally (return (values slot-names slot-binds)))) (body decls (parse-body body)) (slot-decls decls (partition-declarations slot-names decls))) `(macrolet ((:method (name &body args) (mvlet* ((class ',class) (self ',self) (slot-binds ',slot-binds) (qualifiers lambda-list body (parse-defmethod-args args)) (body decls docstring (parse-body body :documentation t)) (ll-with-self (substitute (list self class) self lambda-list))) (when (equal ll-with-self lambda-list) (error "No binding for ~s in ~s" self lambda-list)) `(symbol-macrolet ,(loop for (alias ref) in slot-binds collect (ematch ref ((and ref (type symbol)) `(,alias (slot-value ,self ',ref))) ((list 'function fn) `(,alias (,fn ,self))))) ,@',slot-decls (defmethod ,name ,@qualifiers ,ll-with-self ,@(unsplice docstring) ,@decls ,@body))))) ,@decls ,@body))

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

Input: (mvlet* ((slot-names slot-binds (loop for slot in slots if (listp slot) collect slot into slot-binds and collect (first slot) into slot-names else collect slot into slot-names and collect (list slot slot) into slot-binds finally (return (values slot-names slot-binds)))) (body decls (parse-body body)) (slot-decls decls (partition-declarations slot-names decls))) `(macrolet ((:method (name &body args) (mvlet* ((class ',class) (self ',self) (slot-binds ',slot-binds) (qualifiers lambda-list body (parse-defmethod-args args)) (body decls docstring (parse-body body :documentation t)) (ll-with-self (substitute (list self class) self lambda-list))) (when (equal ll-with-self lambda-list) (error "No binding for ~s in ~s" self lambda-list)) `(symbol-macrolet ,(loop for (alias ref) in slot-binds collect (ematch ref ((and ref (type symbol)) `(,alias (slot-value ,self ',ref))) ((list 'function fn) `(,alias (,fn ,self))))) ,@',slot-decls (defmethod ,name ,@qualifiers ,ll-with-self ,@(unsplice docstring) ,@decls ,@body))))) ,@decls ,@body))

Output:
(defmacro mvlet* ((&rest bindings) &body body &environment env)
  "Expand a series of nested `multiple-value-bind' forms.

`mvlet*' is similar in intent to Scheme’s `let-values', but with a
different and less parenthesis-intensive syntax. Each binding is a
list of

    (var var*... expr)

A simple example should suffice to show both the implementation and
the motivation:

    (defun uptime (seconds)
      (mvlet* ((minutes seconds (truncate seconds 60))
               (hours minutes (truncate minutes 60))
               (days hours (truncate hours 24)))
        (declare ((integer 0 *) days hours minutes seconds))
        (fmt \"~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p\"
             days hours minutes seconds)))

Note that declarations work just like `let*'."
  (cond ((null bindings)
         `(locally ,@body))
        ((every #'simple-binding-p bindings)
         `(let* ,bindings ,@body))
        (t (multiple-value-bind (body decls)
               (parse-body body)
             (let* ((bindings (canonicalize-bindings bindings))
                    (mvbinds (member-if-not #'simple-binding-p bindings))
                    (simple-binds (ldiff bindings mvbinds)))
               (if simple-binds
                   (multiple-value-bind (local other)
                       (partition-declarations (mapcar #'car simple-binds) decls env)
                     `(let* ,simple-binds
                        ,@local
                        (mvlet* ,mvbinds
                          ,@other
                          ,@body)))
                   (let* ((vars (butlast (car bindings)))
                          (expr (lastcar (car bindings))))
                     (multiple-value-bind (local other)
                         (partition-declarations vars decls env)
                       `(multiple-value-bind ,vars
                            ,expr
                          ,@local
                          (mvlet* ,(cdr bindings)
                            ,@other
                            ,@body))))))))))

(multiple-value-bind (slot-names slot-binds) (loop for slot in slots if (listp slot) collect slot into slot-binds and collect (first slot) into slot-names else collect slot into slot-names and collect (list slot slot) into slot-binds finally (return (values slot-names slot-binds))) (mvlet* ((body decls (parse-body body)) (slot-decls decls (partition-declarations slot-names decls))) (sb-int:quasiquote (macrolet ((:method (name &body args) (mvlet* ((class (quote #S(sb-impl::comma :expr class :kind 0))) (self (quote #S(sb-impl::comma :expr self :kind 0))) (slot-binds (quote #S(sb-impl::comma :expr slot-binds :kind 0))) (qualifiers lambda-list body (parse-defmethod-args args)) (body decls docstring (parse-body body :documentation t)) (ll-with-self (substitute (list self class) self lambda-list))) (when (equal ll-with-self lambda-list) (error "No binding for ~s in ~s" self lambda-list)) (sb-int:quasiquote (symbol-macrolet #S(sb-impl::comma :expr (loop for (alias ref) in slot-binds collect (ematch ref ((and ref (type symbol)) (sb-int:quasiquote (#S(sb-impl::comma :expr alias :kind 0) (slot-value #S(sb-impl::comma :expr self :kind 0) (quote #S(sb-impl::comma :expr ref :kind 0)))))) ((list (quote function) fn) (sb-int:quasiquote (#S(sb-impl::comma :expr alias :kind 0) (#S(sb-impl::comma :expr fn :kind 0) #S(sb-impl::comma :expr self :kind 0))))))) :kind 0) #S(sb-impl::comma :expr (quote #S(sb-impl::comma :expr slot-decls :kind 0)) :kind 2) (defmethod #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr qualifiers :kind 2) #S(sb-impl::comma :expr ll-with-self :kind 0) #S(sb-impl::comma :expr (unsplice docstring) :kind 2) #S(sb-impl::comma :expr decls :kind 2) #S(sb-impl::comma :expr body :kind 2))))))) #S(sb-impl::comma :expr decls :kind 2) #S(sb-impl::comma :expr body :kind 2)))))


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

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

Input: (some-<>> nil)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(mvlet* ((x 2) (y x)) x y)

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

Input: (mvlet* ((x 2) (y x)) x y)

Output:
(defmacro mvlet* ((&rest bindings) &body body &environment env)
  "Expand a series of nested `multiple-value-bind' forms.

`mvlet*' is similar in intent to Scheme’s `let-values', but with a
different and less parenthesis-intensive syntax. Each binding is a
list of

    (var var*... expr)

A simple example should suffice to show both the implementation and
the motivation:

    (defun uptime (seconds)
      (mvlet* ((minutes seconds (truncate seconds 60))
               (hours minutes (truncate minutes 60))
               (days hours (truncate hours 24)))
        (declare ((integer 0 *) days hours minutes seconds))
        (fmt \"~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p\"
             days hours minutes seconds)))

Note that declarations work just like `let*'."
  (cond ((null bindings)
         `(locally ,@body))
        ((every #'simple-binding-p bindings)
         `(let* ,bindings ,@body))
        (t (multiple-value-bind (body decls)
               (parse-body body)
             (let* ((bindings (canonicalize-bindings bindings))
                    (mvbinds (member-if-not #'simple-binding-p bindings))
                    (simple-binds (ldiff bindings mvbinds)))
               (if simple-binds
                   (multiple-value-bind (local other)
                       (partition-declarations (mapcar #'car simple-binds) decls env)
                     `(let* ,simple-binds
                        ,@local
                        (mvlet* ,mvbinds
                          ,@other
                          ,@body)))
                   (let* ((vars (butlast (car bindings)))
                          (expr (lastcar (car bindings))))
                     (multiple-value-bind (local other)
                         (partition-declarations vars decls env)
                       `(multiple-value-bind ,vars
                            ,expr
                          ,@local
                          (mvlet* ,(cdr bindings)
                            ,@other
                            ,@body))))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(augment *initial* init)

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

Input: (augment *initial* init)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(*> +open-brace+ +consume-space+)

Problem: Macro call that should be transformed by *>

Input: (*> +open-brace+ +consume-space+)

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

(lambda (#:*>-offset178) (multiple-value-bind (#:*>-res179 #:*>-next180) (funcall +open-brace+ #:*>-offset178) (if (ok? #:*>-res179) (funcall +consume-space+ #:*>-next180) (fail #:*>-next180))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-class bar () ((name "fooname") (age :accessor this-age) (address :accessor nil)) (:accessor-name-transformer (lambda (name def) (declare (ignore def)) name)))

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

Input: (define-class bar () ((name "fooname") (age :accessor this-age) (address :accessor nil)) (:accessor-name-transformer (lambda (name def) (declare (ignore def)) name)))

Output:
(defmacro define-class (name supers slots &rest options)
  "Convenience wrapper of `defclass'.

It automates a lot of boilerplate (like exporting all the accessors of a class)
plus adds some new features.

Slot options:

- The initform can be specified as the second value.

- `:accessor', `:reader' and `:writer' can be set to either a name, NIL or T.
  If NIL, the method is not generated.
  If T, the method is generated using the `:accessor-name-transformer' class option value.

- The `:export' option allows to control the slot-name export on a per-slot basis.

New class options (defaults are NIL unless specified):

- `:slot-definition-transformer' (default: `default-slot-definition-transformer').
  A function that takes a SLOT-DEFINITION and returns a new one.

- `:accessor-name-package': The package of the generated accessors.  See
  `:accessor-name-transformer'.  Some special values are accepted:
  - `:slot-name': The package of the slot-name.
  - `:default': The current package.

- `:accessor-name-transformer' (default `default-accessor-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol).  Other transformer: `dwim-accessor-name-transformer'.

- `:automatic-accessors-p': Whether to generate accessor names automatically for
  all slots.

  As a special case, the accessor is not generated if all following conditions are met:
  - `:accessor-name-package' is `:slot-name',
  - slot name package is different from current package,
  - if the `:accessor' slot option is not provided,

- `:initarg-name-transformer' (default: `default-initarg-name-transformer'.)

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol.

- `:automatic-initargs-p' (default: T): Whether to generate accessor names
  automatically for all slots.

- `:predicate-name-transformer' (default: `default-predicate-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the predicate
  name (a symbol).

- `:automatic-predicates-p' (default: T): Whether to generate a predicate
  for the class.

- `:type-inference' (default: `default-type-inference').

  Function that returns the type of a slot definition (with an initform).  It
  takes 3 arguments:

  - The initform.
  - The slot name.
  - The rest of the slot definition.

- `:automatic-types-p': Whether to generate the type automatically for all
  slots.  The type can still be specified manually with the `:type' slot option.

- Self-explanatory export options (all NIL by default):
  - `:export-class-name-p'
  - `:export-accessor-names-p'
  - `:export-slot-names-p'
  - `:export-predicate-name'"
  (build-defclass-like-expansion
   name supers slots options
   (lambda (processed-slots clean-options)
     `(defclass ,name ,supers
        ,processed-slots
        ,@clean-options))))

(progn (defclass bar nil ((name :initform "fooname" :accessor name :initarg :name) (age :initform nil :accessor this-age :initarg :age) (address :initform nil :initarg :address))) (unless (fboundp (quote barp)) (define-generic barp (object) #A((68) base-char . "Auto-generated predicate for whether OBJECT is an instance of `bar'.") (declare (sb-ext:muffle-conditions style-warning)) (typep object (quote bar)))) (setf (documentation (quote this-age) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE.")) (ignore-errors (setf (documentation (fdefinition (quote this-age)) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE."))) (ignore-errors (setf (documentation (fdefinition (quote (setf this-age))) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE."))) (setf (documentation (quote name) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME.")) (ignore-errors (setf (documentation (fdefinition (quote name)) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME."))) (ignore-errors (setf (documentation (fdefinition (quote (setf name))) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME."))) (find-class (quote bar) nil))


Instruction:
Generate a defmacro form that transforms code like this:
(jbind true t true)

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

Input: (jbind true t true)

Output:
(defmacro jbind (destructuring-pattern form &body body)
  "Match the FORM against DESTRUCTURING-PATTERN.
The pattern might be:
- A symbol, in which case the current chosen form is bound to it. If
  the symbol is _, simply skip the form.
- A literal form:
  - String or number: compare with `equal'.
  - Keywords :TRUE, :FALSE, and :NULL, matching T, NIL, and :NULL
    respectively.
- If the pattern is a property list of string+pattern pairs, match the
  string+pattern pairs inside it to the provided JSON object and
  resolve them recursively.
- If the pattern is a list of symbols (VAR &optional VAR-P), these are
  bound to the respective values of `jget'. It is a good way to make
  `jbind' to be more lenient to missing keys, because the default
  behavior is to error on missing data.
- If the pattern is an inline vector, match it against a JSON array
  with at least as many elements as provided in the vector. Match
  every form in the vector against the element with the same index.

If the DESTRUCTURING-PATTERN doesn't match the object, throw
`value-mismatch'.

Underlying `jget' can throw errors for the exceptionally malformed
inputs. See `jget' documentation for the types of errors it throws.

Example:
\(\"hello\" hello \"a\" _ \"b\" b
 \"array\" #(first second third _))

matches a JSON object
{\"hello\": 3, \"a\": 8, \"b\": 3, \"c\": null, \"array\": [1, 2, 3, 4]}

and binds
- HELLO to 3
- B to 3
- FIRST to 1
- SECOND to 2
- THIRD to 3

It also checks that \"a\" key is present in the object and there's a
fourth element in the nested array.

See more examples in njson tests."
  (let ((form-sym (gensym "BIND-FORM"))
        (bindings (list)))
    (labels ((parse-pattern (pattern &optional (current-path (list)))
               (etypecase pattern
                 ((or (member :true :false :null) string real)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 ((cons symbol *)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 (list
                  (loop for (key subpattern) on pattern by #'cddr
                        do (parse-pattern subpattern (append current-path (list key))))
                  (push (cons nil (copy-list current-path))
                        bindings))
                 ((and symbol (not keyword))
                  (push (cons (if (equal "_" (symbol-name pattern))
                                  (gensym "_PATTERN")
                                  pattern)
                              (copy-list current-path))
                        bindings))
                 (array
		  (loop for elem across pattern
                        for index from 0
                        do (parse-pattern elem (append current-path (list index))))
		  (push (cons #() (copy-list current-path))
			bindings)))))
      (check-type destructuring-pattern (or list (and array (not string))
                                            (and symbol (not keyword)))
                  "proper jbind destructuring pattern: list, array, or symbol")
      (parse-pattern destructuring-pattern)
      (let ((let-forms (loop for (binding . key) in bindings
                             do (check-type binding (or array real symbol
                                                        ;; For (VAR VAR-P) forms
                                                        (cons symbol (or (cons symbol null)
                                                                         null))))
                             if (typep binding '(or array real null
                                                 (member :true :false :null)))
                               collect `(,(gensym) (check-value ,binding (vector ,@key) ,form-sym))
                             else if (and (symbolp binding)
                                          (uiop:emptyp key))
                                    collect `(,binding ,form-sym)
                             else if (listp binding)
                                    append (destructuring-bind (var &optional (var-p nil var-p-provided))
                                               binding
                                             (append
                                              `((,var (jget (vector ,@key) ,form-sym)))
                                              (when var-p-provided
                                                `((,var-p (nth-value 1 (jget (vector ,@key) ,form-sym)))))))
                             else
                               collect `(,binding (check-value t (vector ,@key) ,form-sym)))))
        `(let* ((,form-sym ,form)
                ,@let-forms)
           (declare (ignorable ,form-sym ,@(mapcar #'first let-forms)))
           ,@body))))

(let* ((#:bind-form125 t) (true #:bind-form125)) (declare (ignorable #:bind-form125 true)) true)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(check-cursor-attached cluffer:backward-item (cursor))

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

Input: (check-cursor-attached cluffer:backward-item (cursor))

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

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


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

Issue: Macro call that should be transformed by WHEN

Input: (when 'some-name)

Output: (defmacro WHEN ...)


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

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

Input:
(resolving
  nil)

Output: (defmacro RESOLVING ...)


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

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

Input: (cond->> nil)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(builder (:session :keep-empty nil) (lambda (env) (when (string= (getf env :path-info) "/session") (setf (gethash "user" (getf env :lack.session)) "Eitaro")) '(200 () ("hi"))))

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

Input: (builder (:session :keep-empty nil) (lambda (env) (when (string= (getf env :path-info) "/session") (setf (gethash "user" (getf env :lack.session)) "Eitaro")) '(200 () ("hi"))))

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 (#:app224) (funcall (find-middleware :session) #:app224 :keep-empty nil)))) :initial-value (to-app (lambda (env) (when (string= (getf env :path-info) "/session") (setf (gethash "user" (getf env :lack.session)) "Eitaro")) (quote (200 nil ("hi"))))) :from-end t)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-quote-char (format out "~{~{~A;~%~}~^~%~}" (mapcar (lambda (class) (mapcar #'sxql:yield (table-definition class))) (all-dao-classes))) (format out "~2&~A;~%" (sxql:yield (schema-migrations-table-definition))))

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

Input: (with-quote-char (format out "~{~{~A;~%~}~^~%~}" (mapcar (lambda (class) (mapcar #'sxql:yield (table-definition class))) (all-dao-classes))) (format out "~2&~A;~%" (sxql:yield (schema-migrations-table-definition))))

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

(let ((sxql/sql-type:*quote-character* (or sxql/sql-type:*quote-character* (connection-quote-character *connection*)))) (format out "~{~{~A;~%~}~^~%~}" (mapcar (lambda (class) (mapcar (function sxql/sql-type:yield) (table-definition class))) (all-dao-classes))) (format out "~2&~A;~%" (sxql/sql-type:yield (schema-migrations-table-definition))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(when (node-slot linebreak) (format stream "~&~a" indent))

Issue: Macro call that should be transformed by when

Input: (when (node-slot linebreak) (format stream "~&~a" indent))

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

(if (node-slot linebreak) (format stream "~&~a" indent))


Instruction:
Define a macro that eliminates this repetitive pattern:
(match either m ((right x) (funcall f x)) ((left b) (left b)))

Issue: Macro call that should be transformed by match

Input: (match either m ((right x) (funcall f x)) ((left b) (left b)))

Output:
(defmacro match (adt obj &body clauses)
  "Perform pattern matching on OBJ with (adt-type) ADT.

Each clause must have the following syntax:

<var> := <symbol> | '_'
<lhs> := '_'
       | (<symbol> <var>*)
<clause> := (<lhs> <lisp code>)

The symbol '_' denotes a wildcard, as well as a fallthough.

Note that pattern matching is only shallow (patterns are one-level
deep).
"
  (assert (symbolp adt)
          (adt)
          "MATCH requires a symbol for the first argument. Given ~S."
          adt)

  (let ((ctors (mapcar #'car (get-constructors adt)))
        (types (mapcar (lambda (clause)
                         (ensure-car (car clause)))
                       clauses))
        (once (gensym "OBJ-")))

    ;; Check for duplicate matches.
    (let ((dupes (duplicates types)))
      (when dupes
        (warn "Duplicate matching clauses exist. Duplicate pattern ~
               constructors:~{ ~S~}"
              dupes)))

    ;; Check for match exhaustiveness.
    (unless (some #'wild? types)
      (let ((diff (set-difference ctors types)))
        (when diff
          (warn "Non-exhaustive match on ~A data ~
                 type. Missing cases:~{ ~S~}" adt diff))))

    ;; Generate the matching code.
    `(let ((,once ,obj))
       (check-type ,once ,adt)
       (etypecase ,once
         ,@(loop :for (bindings . body) :in clauses
                 :collect (let ((type (ensure-car bindings)))
                            (if (wild? type)
                                `(t ,@body)
                                `(,type
                                  (with-data ,(ensure-list bindings)
                                             ,once
                                    ,@body)))))))))

(let ((#:obj-149 m)) (check-type #:obj-149 either) (etypecase #:obj-149 (right (with-data (right x) #:obj-149 (funcall f x))) (left (with-data (left b) #:obj-149 (left b)))))


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

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

Input:
(with-rules nil
  nil)

Output: (defmacro WITH-RULES ...)

(dolist (nil (alexandria:hash-table-keys cl-rules.core::*rules*)) nil)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(augment prev-code prev)

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

Input: (augment prev-code prev)

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


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

Problem: Macro call that should be transformed by ƑƑ

Input: (ƒƒ 'some-name)

Output: (defmacro ƑƑ ...)


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

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

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
($map-reduce "foo" m r :out "testit" :query ($> "l" -900))

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

Input: ($map-reduce "foo" m r :out "testit" :query ($> "l" -900))

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

(db.find "$cmd" (kv (kv "mapreduce" "foo") (kv "map" (or (jsdef m) (quote m))) (kv "reduce" (or (jsdef r) (quote r))) (when nil (kv "finalize" (jsdef nil))) (kv "out" (if "testit" "testit" (concatenate (quote string) "mr." "foo"))) (kv "verbose" t) (kv "limit" 0) (kv "keeptemp" nil) (kv "query" ($> "l" -900))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(without-package-lock (:common-lisp #+lispworks :implementation) (defmethod print-object :around ((rt readtable) stream) (let ((name (readtable-name rt))) (if name (print-unreadable-object (rt stream :type nil :identity t) (format stream "~A ~S" :named-readtable name)) (call-next-method)))))

What needs to change: Macro call that should be transformed by without-package-lock

Input: (without-package-lock (:common-lisp #+lispworks :implementation) (defmethod print-object :around ((rt readtable) stream) (let ((name (readtable-name rt))) (if name (print-unreadable-object (rt stream :type nil :identity t) (format stream "~A ~S" :named-readtable name)) (call-next-method)))))

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

(progn (defmethod print-object :around ((rt readtable) stream) (let ((name (readtable-name rt))) (if name (print-unreadable-object (rt stream :type nil :identity t) (format stream "~A ~S" :named-readtable name)) (call-next-method)))))


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

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

Input: (defrte nil nil)

Output: (defmacro DEFRTE ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (getf (symbol-plist '-nil) :rte-pattern) 'nil
        (gethash 'nil *rte-hash*) 'nil)
  (defun -nil (seq)
    (declare (optimize (speed 3) (debug 0) (safety 0)))
    (block check
      (typecase seq
        (list
         (tagbody
           (go 1)
          1
           (if (null seq)
               (return-from check nil)
               (case (pop seq) (t (return-from check nil))))))
        (simple-vector
         (let ((i 0) (len (length seq)))
           (declare (type (and unsigned-byte fixnum) i len)
                    (ignorable len))
           (tagbody
             (go 1)
            1
             (if (>= i len)
                 (return-from check nil)
                 (case (prog1 (svref seq i) (incf i))
                   (t (return-from check nil)))))))
        (vector
         (let ((i 0) (len (length seq)))
           (declare (type (and fixnum unsigned-byte) i len)
                    (ignorable len))
           (tagbody
             (go 1)
            1
             (if (>= i len)
                 (return-from check nil)
                 (case (prog1 (aref seq i) (incf i))
                   (t (return-from check nil)))))))
        (sequence
         (let ((i 0) (len (sb-sequence:length seq)))
           (declare (type (and fixnum unsigned-byte) i len)
                    (ignorable len))
           (tagbody
             (go 1)
            1
             (if (or (sb-sequence:emptyp seq) (>= i len))
                 (return-from check nil)
                 (case (prog1 (sb-sequence:elt seq i) (incf i))
                   (t (return-from check nil)))))))
        (t nil)))))


Instruction:
Generate a defmacro form that transforms code like this:
(signal-syntax-error "Unknown symbol ~A in character class." item)

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

Input: (signal-syntax-error "Unknown symbol ~A in character class." item)

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

(signal-syntax-error* nil "Unknown symbol ~A in character class." item)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-data (rect x y) pt (set-data pt (rect y x)))

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

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

Output:
(defmacro with-data ((name &rest vars) obj &body body)
  "Destructure the ADT value OBJ, whose constructor is NAME. VARS must
be symbol which will be bound, or they must be the symbol '_', which
means the value will not be bound."
  (let* ((once (gensym "ONCE-"))
         (bindings (loop :for i :from 0
                         :for v :in vars
                         :when (not (wild? v))
                           :collect `(,v (,(field name i)
                                          ,once)))))
    `(let ((,once ,obj))
       (declare (ignorable ,once))
       (let (,@bindings)
         ,@body))))

(let ((#:once-146 pt)) (declare (ignorable #:once-146)) (let ((x (rect%0 #:once-146)) (y (rect%1 #:once-146))) (set-data pt (rect y x))))


Instruction:
Generate a defmacro form that transforms code like this:
(define EXIT_FAILURE 1)

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

Input: (define EXIT_FAILURE 1)

Output:
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *preprocessor-defines* (make-hash-table)) (setf (gethash (quote exit_failure) *preprocessor-defines*) #A((1) base-char . "1"))) (defparameter exit_failure 1))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun get-node (node-id) :get (:uri-spec (if node-id (format nil "node/~A" node-id) "")) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

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

Input: (def-neo4j-fun get-node (node-id) :get (:uri-spec (if node-id (format nil "node/~A" node-id) "")) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

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

(progn (defun get-node (&key node-id) (let ((uri (if node-id (format nil "node/~A" node-id) "")) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(alist-bind (type) form (alist-bind ((type-tag :tag)) type (cond ((or (string= ":char" type-tag) (string= ":unsigned-char" type-tag)) '((:string))) (t `((:pointer ,@(parse-type type type-tag)))))))

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

Input: (alist-bind (type) form (alist-bind ((type-tag :tag)) type (cond ((or (string= ":char" type-tag) (string= ":unsigned-char" type-tag)) '((:string))) (t `((:pointer ,@(parse-type type type-tag)))))))

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

(let ((#:alist234 form)) (let ((type (aval :type #:alist234))) (alist-bind ((type-tag :tag)) type (cond ((or (string= ":char" type-tag) (string= ":unsigned-char" type-tag)) (quote ((:string)))) (t (sb-int:quasiquote ((:pointer #S(sb-impl::comma :expr (parse-type type type-tag) :kind 2)))))))))


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

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

Input:
(letrec nil
  nil)

Output: (defmacro LETREC ...)

(let ()
  (flet ()
    nil
    (setf)
    nil))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (when (slot-value report 'description) (format/indent reporter stream (concatenate 'string "~&" (report-expected-line report)))))

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

Input: (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (when (slot-value report 'description) (format/indent reporter stream (concatenate 'string "~&" (report-expected-line report)))))

Output:
(defmacro with-additional-indent ((reporter stream control-string &rest format-arguments) &body body)
  (declare (ignorable reporter stream control-string))
  (let* ((need-new-line (ppcre:scan "^~&" control-string))
         (string (apply #'format nil control-string format-arguments))
         (increment (length string)))
    `(with-slots (indent-space) reporter
       (let* ((first-line-indent (indent indent-space))
              (*additional-indent* ,(if need-new-line
                                        increment
                                        `(+ *additional-indent*
                                            ,increment))))
         (declare (ignorable first-line-indent))
         ,(if need-new-line
              `(progn (fresh-line stream)
                      (write-string first-line-indent ,stream)
                      ;; because we just started a new line, we
                      ;; should use format/indent to write string
                      ;; taking into account a main indentation level
                      (format/indent ,reporter ,stream ,string))
              ;; otherwise, just output our prefix
              `(write-string ,string ,stream))

         ,@body))))

(with-slots (indent-space) reporter (let* ((first-line-indent (indent indent-space)) (*additional-indent* (+ *additional-indent* 2))) (declare (ignorable first-line-indent)) (write-string "× " stream) (let ((description (possible-report-description report)) (duration (slot-value report (quote duration)))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report (quote slow-threshold))))) (when (slot-value report (quote description)) (format/indent reporter stream (concatenate (quote string) "~&" (report-expected-line report))))))


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

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

Input: (-> :two () (increment))

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


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

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

Input: (defproto 'some-name)

Output: (defmacro DEFPROTO ...)

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


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

Problem: Macro call that should be transformed by DRELET*

Input: (drelet* 'some-name)

Output: (defmacro DRELET* ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(if-let (x (opaque nil)) :bad (and (not x) :ok))

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

Input: (if-let (x (opaque nil)) :bad (and (not x) :ok))

Output:
(defmacro if-let (bindings &body (then-form &optional else-form))
    "Creates new variable bindings, and conditionally executes either
THEN-FORM or ELSE-FORM. ELSE-FORM defaults to NIL.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

 ((variable-1 initial-form-1)
  (variable-2 initial-form-2)
  ...
  (variable-n initial-form-n))

All initial-forms are executed sequentially in the specified order. Then all
the variables are bound to the corresponding values.

If all variables were bound to true values, the THEN-FORM is executed with the
bindings in effect, otherwise the ELSE-FORM is executed with the bindings in
effect."
    (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
                             (list bindings)
                             bindings))
         (variables (mapcar #'car binding-list)))
    `(let ,binding-list
       (if (and ,@variables)
           ,then-form
           ,else-form))))

(let ((x (opaque nil))) (if (and x) :bad (and (not x) :ok)))


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

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

Input: (ƒ nil)

Output: (defmacro Ƒ ...)

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


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

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

Input: (collect-fn nil :key nil)

Output: (defmacro COLLECT-FN ...)

(common-lisp:let* ((#:c-176 (common-lisp:funcall :key)))
  (tagbody
   #:ll-181
    (setq #:c-176 (common-lisp:funcall nil #:c-176))
    (go #:ll-181))
  #:c-176)


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

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

Input: (with-reader-case 'some-name)

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

(let ()
  (let ((#:previous-case182 (readtable-case *readtable*)))
    (setf (readtable-case *readtable*) 'some-name)
    (unwind-protect (progn)
      (setf (readtable-case *readtable*) #:previous-case182))))


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

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

Input: (c-assert self)

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

(unless *stop* (unless self (c-break "failed assertion: ~a" (quote self))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(deftag h* (body attrs &key) `(dynamic-tag :name (heading-depth-heading) ,@attrs ,@body))

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

Input: (deftag h* (body attrs &key) `(dynamic-tag :name (heading-depth-heading) ,@attrs ,@body))

Output:
(defmacro deftag (name (body attrs-var &rest ll) &body tag)
  "Define NAME as a tag.
If NAME is not a keyword, it will also be defined as a macro with an
implicit `with-html'."
  (let ((definer
          (if (keywordp name)
              'deftag/keyword
              'deftag/macro)))
    `(,definer ,name (,body ,attrs-var ,@ll) ,@tag)))

(deftag/macro h* (body attrs &key) (sb-int:quasiquote (dynamic-tag :name (heading-depth-heading) #S(sb-impl::comma :expr attrs :kind 2) #S(sb-impl::comma :expr body :kind 2))))