Instruction:
Generate a defmacro form that transforms code like this:
(defgenerator islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))))))

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

Input: (defgenerator islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))))))

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

(defun islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (with-yield (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error invalid-function-return-spec () (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)

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

Input: (define-error invalid-function-return-spec () (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)

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

(defcondition invalid-function-return-spec (:error-type varjo-error :prefix "Varjo") (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (= 0 (add-2 -2)))

Issue: Macro call that should be transformed by is

Input: (is (= 0 (add-2 -2)))

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is (not (plusp -1)))

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

Input: (is (not (plusp -1)))

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 ((#:v184 -1)) (if (not (plusp #:v184)) (add-result (quote test-passed) :test-expr (quote (not (plusp -1)))) (process-failure (quote (not (plusp -1))) "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)" (quote -1) #:v184 (quote plusp))))


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

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

Input: (is-true nil)

Output:
(defmacro is-true (condition &rest reason-args)
  "Like IS this check generates a pass if CONDITION returns true
  and a failure if CONDITION returns false. Unlike IS this check
  does not inspect CONDITION to determine how to report the
  failure."
  `(if ,condition
       (add-result 'test-passed :test-expr ',condition)
       (process-failure ',condition
                        ,@(or reason-args
                              `("~S did not return a true value" ',condition)))))

(if nil (add-result (quote test-passed) :test-expr (quote nil)) (process-failure (quote nil) "~S did not return a true value" (quote nil)))


Instruction:
Generate a defmacro form that transforms code like this:
(lambda (quote some-name))

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

Input: (lambda (quote some-name))

Output: (defmacro LAMBDA ...)


Instruction:
Generate a defmacro form that transforms code like this:
(augment step-code prev-code)

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

Input: (augment step-code prev-code)

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

(setf step-code (nconc step-code prev-code))


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

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

Input: (some-<>> (diamond-wand init (cddr exp) t t))

Output: (defmacro some-<> (init &body exps) (diamond-wand init exps nil t))

(block #:g127 (diamond-wand init (cddr exp) t t))


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

Problem: Macro call that should be transformed by bind

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

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

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

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

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

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


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

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

Input: (case nil)

Output: (defmacro CASE ...)

(let ((#:nil nil))
  (declare (ignorable #:nil))
  (cond))


Instruction:
Generate a defmacro form that transforms code like this:
(with-ps-gensyms nil
  :key
  nil)

Pattern to recognize: Macro call that should be transformed by WITH-PS-GENSYMS

Input:
(with-ps-gensyms nil
  :key
  nil)

Output: (defmacro WITH-PS-GENSYMS ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-expander slot-value 1 (expr val new-val) `(let ((new (copy-instance ,val))) (setf (slot-value new ,(third expr)) ,new-val) new))

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

Input: (define-modf-expander slot-value 1 (expr val new-val) `(let ((new (copy-instance ,val))) (setf (slot-value new ,(third expr)) ,new-val) new))

Output:
(defmacro define-modf-expander (name nth-arg
                                (expr val new-val)
                                &body body)
  "Define a new expander which inverts forms starting with NAME.  Your function
should return an expansion from EXPR to a form that will build a new object that
has NEW-VAL in the place specified by expr.  NTH-ARG marks which argument is
considered the actual data which will be inverted next."
  (setf
   (gethash name *modf-nth-arg*)
   nth-arg)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (gethash ',name *modf-nth-arg*)
      ,nth-arg
      (gethash ',name *modf-expansions*)
      (lambda (,expr ,val ,new-val)
        ,@body))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote slot-value) *modf-nth-arg*) 1 (gethash (quote slot-value) *modf-expansions*) (lambda (expr val new-val) (sb-int:quasiquote (let ((new (copy-instance #S(sb-impl::comma :expr val :kind 0)))) (setf (slot-value new #S(sb-impl::comma :expr (third expr) :kind 0)) #S(sb-impl::comma :expr new-val :kind 0)) new)))))


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

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

Input:
(define-macro nil
    :key
    nil)

Output: (defmacro DEFINE-MACRO ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (get 'nil ':key)
          (lambda (#:whole122 #:no-environment)
            (declare (ignorable #:no-environment))
            (handler-case
             (destructuring-bind
                 (#:namevar123)
                 #:whole122
               (declare (ignore #:namevar123)))
             (error (e) (error 'foo-syntax-error :form #:whole122 :cause e))))))


Instruction:
Generate a defmacro form that transforms code like this:
(letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

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

Input: (letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

Output:
(defmacro letrec ((&rest bindings) &body body)
  "Recursive LET.
The idea is that functions created in BINDINGS can close over one
another, and themselves.

Note that `letrec' only binds variables: it can define recursive
functions, but can't bind them as functions. (But see `fbindrec'.)"
  `(letrec-with psetq ,bindings
     ,@body))

(letrec-with setq ((f (constantly t)) (a (funcall f))) (is-true a))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-env [assoc-list 'a])

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

Input: (with-env [assoc-list 'a])

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

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


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

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

Input: (with-unbuilder 'some-name)

Output: (defmacro WITH-UNBUILDER ...)

(flet ((with-builder-thunk (quote)
         ))
  (declare (dynamic-extent (function with-builder-thunk)))
  (call-with-unbuilder some-name #'with-builder-thunk))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (and (first first-statement) (eql (first parent-node) 'compound-statement) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))

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

Input: (when (and (first first-statement) (eql (first parent-node) 'compound-statement) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))

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

(if (and (first first-statement) (eql (first parent-node) (quote compound-statement)) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun-speedy read-until-crlf*2 (stream) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) eof)))

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

Input: (defun-speedy read-until-crlf*2 (stream) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) eof)))

Output:
(defmacro defun-speedy (name lambda-list &body body)
  `(progn
     (declaim (notinline ,name))
     (defun ,name ,lambda-list
       ,*speedy-declaration*
       ,@body)))

(progn (declaim (notinline read-until-crlf*2)) (defun read-until-crlf*2 (stream) (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (t (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (t (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (t (fast-write-byte next-byte buf) (go read-cr))))) eof))))


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

Problem: Macro call that should be transformed by F

Input: (f nil)

Output: (defmacro F ...)


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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclass/a dbd-null-connection (cl-dbi:dbi-connection) ())

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

Input: (defclass/a dbd-null-connection (cl-dbi:dbi-connection) ())

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

(progn (defclass dbd-null-connection (dbi.driver:dbi-connection) nil) (deftype <dbd-null-connection> nil (quote dbd-null-connection)) (setf (find-class (quote <dbd-null-connection>)) (find-class (quote dbd-null-connection))))


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

Problem: Macro call that should be transformed by PRODUCING

Input: (producing)

Output: (defmacro PRODUCING ...)


Instruction:
Generate a defmacro form that transforms code like this:
(do+ (for x (in '(1 2 3 4))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))

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

Input: (do+ (for x (in '(1 2 3 4))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))

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

(do+/internal nil (for x (in (quote (1 2 3 4)))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time indirect-callees (function-name) (indirect-callees-internal (callees function-name) '()))

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

Input: (defun-compile-time indirect-callees (function-name) (indirect-callees-internal (callees function-name) '()))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun indirect-callees (function-name) (indirect-callees-internal (callees function-name) (quote nil))) (eval-when (:compile-toplevel) (compile (quote indirect-callees))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-alias-binding reduce reducing)

Issue: Macro call that should be transformed by define-alias-binding

Input: (define-alias-binding reduce reducing)

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

(progn (setf (binding (quote reduce)) (quote reducing)) (quote reduce))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(check-cursor-attached cluffer:beginning-of-line (cursor))

What needs to change: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:beginning-of-line (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:beginning-of-line :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(enable-quasi-quoted-string-syntax)

Write a macro that addresses: Macro call that should be transformed by ENABLE-QUASI-QUOTED-STRING-SYNTAX

Input: (enable-quasi-quoted-string-syntax)

Output: (defmacro ENABLE-QUASI-QUOTED-STRING-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quoted-string-syntax-in-readtable :start-character nil
                                               :end-character nil
                                               :unquote-character #\COMMA
                                               :splice-character
                                               #\COMMERCIAL_AT
                                               :destructive-splice-character
                                               #\FULL_STOP
                                               :dispatched-quasi-quote-name
                                               "str" :transformation-pipeline
                                               nil)
  (values))


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

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

Input: (with-collectors 'some-name)

Output: (defmacro WITH-COLLECTORS ...)

(with-collector (quote)
  (with-collectors (some-name)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defclause being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then))

Problem: Macro call that should be transformed by defclause

Input: (defclause being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then))

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 being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then)) (pushnew (quote being) *clauses*))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(->> (v) (flow-gen v))

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

Input: (->> (v) (flow-gen v))

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


Instruction:
Generate a defmacro form that transforms code like this:
(define-custom-var (:beginning-of-array *beginning-of-array-handler*) (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")

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

Input: (define-custom-var (:beginning-of-array *beginning-of-array-handler*) (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*beginning-of-array-handler* . :beginning-of-array)) *custom-vars* :test (function equal)) (defvar *beginning-of-array-handler* (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-preprocessor-state-slots (state) (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error 'preprocess-error :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state) ) i-state))

Write a macro that addresses: Macro call that should be transformed by with-preprocessor-state-slots

Input: (with-preprocessor-state-slots (state) (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error 'preprocess-error :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state) ) i-state))

Output:
(defmacro with-preprocessor-state-slots ((state) &body body)
  `(with-accessors ((file-pathname pp-state-file-pathname)
                    (token-list pp-state-token-list)
                    (result-list pp-state-result-list)
                    (line-number pp-state-line-number)
                    (tokens-in-line pp-state-tokens-in-line)
                    (macro-alist pp-state-macro-alist)
                    (if-section-stack pp-state-if-section-stack)
                    (if-section-skip-reason pp-state-if-section-skip-reason)
                    (include-stack pp-state-include-stack))
       ,state
     ,@body))

(with-accessors ((file-pathname pp-state-file-pathname) (token-list pp-state-token-list) (result-list pp-state-result-list) (line-number pp-state-line-number) (tokens-in-line pp-state-tokens-in-line) (macro-alist pp-state-macro-alist) (if-section-stack pp-state-if-section-stack) (if-section-skip-reason pp-state-if-section-skip-reason) (include-stack pp-state-include-stack)) state (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error (quote preprocess-error) :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state)) i-state))


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

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

Input:
(dynenv-macrolet nil
  (progn))

Output: (defmacro DYNENV-MACROLET ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(*> +any-space+ +skip-all-space+ +pairs+)

Problem: Macro call that should be transformed by *>

Input: (*> +any-space+ +skip-all-space+ +pairs+)

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 (#:*>-offset254) (multiple-value-bind (#:*>-res257 #:*>-next258) (multiple-value-bind (#:*>-res255 #:*>-next256) (funcall +any-space+ #:*>-offset254) (if (ok? #:*>-res255) (funcall +skip-all-space+ #:*>-next256) (fail #:*>-next256))) (if (ok? #:*>-res257) (funcall +pairs+ #:*>-next258) (fail #:*>-next258))))


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

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

Input: (-<>> nil (progn))

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-direct-binding when (var test sub-binding &rest args) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init `(when ,test ,body) value)))

Issue: Macro call that should be transformed by define-direct-binding

Input: (define-direct-binding when (var test sub-binding &rest args) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init `(when ,test ,body) value)))

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

(progn (setf (binding (quote when)) (lambda (var test sub-binding &rest args) (let ((#:environment125 *environment*)) (declare (ignorable #:environment125)) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init (sb-int:quasiquote (when #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr body :kind 0))) value))))) (quote when))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-function getf 2 (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist))

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

Input: (define-modf-function getf 2 (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist))

Output:
(defmacro define-modf-function (name nth-arg (new-val &rest args) &body body)
  "Define a new modf function.  It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro."
  ;; Side effect in a macro, I know.  How can you do this via EVAL-WHEN if I
  ;; want it to run even if not a toplevel macro?
  (setf (gethash name *modf-nth-arg*)
        nth-arg)
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (setf (gethash ',name *modf-nth-arg*)
             ,nth-arg))
     (defun ,(intern (modf-name name) :modf) (,new-val ,@args)
       ,@body)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote getf) *modf-nth-arg*) 2)) (defun |BUILDER:COMMON-LISP:GETF| (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-modf-rewrite cdaddr (expr) `(cdr (caddr ,(second expr))))

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

Input: (define-modf-rewrite cdaddr (expr) `(cdr (caddr ,(second expr))))

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu))

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

Input: (with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu))

Output:
(defmacro with-flow-function-macro ((fu-name fu-lambda-list fu-body) &body body)
  `(with-gensyms (,fu-name)
     `(%with-flow-function (,,fu-name ,,fu-lambda-list ,@,fu-body)
        ,,@body)))

(with-gensyms (body-fu) (sb-int:quasiquote (%with-flow-function (#S(sb-impl::comma :expr body-fu :kind 0) #S(sb-impl::comma :expr lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)) #S(sb-impl::comma :expr (sb-int:quasiquote (dispatch-dynamically #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr body-fu :kind 0)))) :kind 0))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is = 5 5)

Issue: Macro call that should be transformed by is

Input: (is = 5 5)

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

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


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

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

Input: (collecting 'some-name)

Output: (defmacro COLLECTING ...)

(with-collector-output (output)
  (dolist (quote (alexandria:ensure-list some-name))
    (restart-case (output (progn))
      (skip nil "Skip this element"))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-capped-stack () (make-instance 'environment :condition condition))

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

Input: (with-capped-stack () (make-instance 'environment :condition condition))

Output:
(defmacro with-capped-stack (() &body body)
  `(stack-capper (lambda () ,@body)))

(stack-capper (lambda nil (make-instance (quote environment) :condition condition)))


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

Problem: Macro call that should be transformed by ->

Input: (-> :g () 1)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-html-string (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "...")))))

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

Input: (with-html-string (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "...")))))

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 (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "..."))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(deferror "57P03" cannot-connect-now operator-intervention)

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

Input: (deferror "57P03" cannot-connect-now operator-intervention)

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

(progn (define-condition cannot-connect-now (operator-intervention) nil) (setf (gethash "57P03" *error-table*) (quote cannot-connect-now)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(is-type 1 'string)

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

Input: (is-type 1 'string)

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

(let ((#:desc179 nil) (#:expected-type180 (quote string))) (with-catching-errors (:description #:desc179 :expected #:expected-type180) (with-duration ((#:duration177 #:result178) 1) (test #:result178 #:expected-type180 #:desc179 :duration #:duration177 :got-form (quote 1) :test-fn (function typep) :report-expected-label "be a type of"))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-element-maker :group "g" '())

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

Input: (define-element-maker :group "g" '())

Output:
(defmacro define-element-maker (element name required-attributes)
  `(progn
     (defmethod assert-required-attributes ((element (eql ,element)) attributes)
       (declare (ignore element))
       (unless (evenp (length attributes))
         (warn "attribute list may be missing data: ~A" attributes))
       (let ((missing (set-difference ,required-attributes attributes)))
	 (when missing
	   (error 'missing-attributes :message (format nil "~A missing attributes: ~{~A~^ ~}" ,element missing)))))
     (defmethod make-svg-element ((element (eql ,element)) attributes)
       (when *check-required-attributes*
         (assert-required-attributes element attributes))
       (make-instance 'svg-element :name ,name :attributes attributes))))

(progn (defmethod assert-required-attributes ((element (eql :group)) attributes) (declare (ignore element)) (unless (evenp (length attributes)) (warn "attribute list may be missing data: ~A" attributes)) (let ((missing (set-difference (quote nil) attributes))) (when missing (error (quote missing-attributes) :message (format nil "~A missing attributes: ~{~A~^ ~}" :group missing))))) (defmethod make-svg-element ((element (eql :group)) attributes) (when *check-required-attributes* (assert-required-attributes element attributes)) (make-instance (quote svg-element) :name "g" :attributes attributes)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(multiple-value-prog2 (values 1 1 1) (values 2 20 200) (values 3 3 3))

Write a macro that addresses: Macro call that should be transformed by multiple-value-prog2

Input: (multiple-value-prog2 (values 1 1 1) (values 2 20 200) (values 3 3 3))

Output:
(defmacro multiple-value-prog2 (first-form second-form &body forms)
  "Evaluates FIRST-FORM, then SECOND-FORM, and then FORMS. Yields as its value
all the value returned by SECOND-FORM."
  `(progn ,first-form (multiple-value-prog1 ,second-form ,@forms)))

(progn (values 1 1 1) (multiple-value-prog1 (values 2 20 200) (values 3 3 3)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(assoc-cdr :token--endpoint disc)

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

Input: (assoc-cdr :token--endpoint disc)

Output:
(defmacro assoc-cdr (key alist &optional (test '#'eql))
  `(cdr (assoc ,key ,alist :test ,test)))

(cdr (assoc :token--endpoint disc :test (function eql)))


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

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

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

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

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


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

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

Input: (ψ 'some-name)

Output: (defmacro Ψ ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-modf-method pathname-directory 1 (new-val path) (make-pathname :directory new-val :defaults path))

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

Input: (define-modf-method pathname-directory 1 (new-val path) (make-pathname :directory new-val :defaults path))

Output:
(defmacro define-modf-method (name nth-arg (new-val &rest args) &body body)
  "Define a new modf method.  It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro.  This method can
specialize on any of ARGS."
  ;; Side effect in a macro, I know.  How can you do this via EVAL-WHEN if I
  ;; want it to run even if not a toplevel macro?
  (setf (gethash name *modf-nth-arg*)
        nth-arg)
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (setf (gethash ',name *modf-nth-arg*)
             ,nth-arg))
     (defmethod ,(intern (modf-name name) :modf) (,new-val ,@args)
       ,@body)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote pathname-directory) *modf-nth-arg*) 1)) (defmethod |BUILDER:COMMON-LISP:PATHNAME-DIRECTORY| (new-val path) (make-pathname :directory new-val :defaults path)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-iter iterator-range (curr stop step) (range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step)) (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))

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

Input: (def-iter iterator-range (curr stop step) (range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step)) (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname131 (&key curr stop step) (labels ((self nil (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))) (function self)))) (defun range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname131)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step))))


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

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

Input: (defpackage nil)

Output: (defmacro DEFPACKAGE ...)

(common-lisp:defpackage nil
  (:use :adhoc :closer-mop :cl)
  (:shadowing-import-from :closer-mop
                          #:defmethod
                          #:standard-generic-function
                          #:defgeneric
                          #:standard-method
                          #:standard-class)
  (:shadowing-import-from :adhoc #:defpackage #:variable #:the))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause (collect expr &optional into var at (place 'end) result-type (type 'list)) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation 'cons :end-operation '(subst (var expr) (list expr)) :place place :result-type type))

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

Input: (defclause (collect expr &optional into var at (place 'end) result-type (type 'list)) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation 'cons :end-operation '(subst (var expr) (list expr)) :place place :result-type type))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-collect-18 (&key ((:collect expr)) ((:into var)) ((:at place) (quote end)) ((:result-type type) (quote list))) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation (quote cons) :end-operation (quote (subst (var expr) (list expr))) :place place :result-type type)) (install-clause-info (quote (collect)) (quote (collect &optional :into :at :result-type)) (quote clause-collect-18) "Collect into a list" nil) (quote (collect expr &optional into var at (place (quote end)) result-type (type (quote list)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (second item) `(declaration-value (make-node ,(second item))))

Problem: Macro call that should be transformed by when

Input: (when (second item) `(declaration-value (make-node ,(second item))))

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

(if (second item) (sb-int:quasiquote (declaration-value (make-node #S(sb-impl::comma :expr (second item) :kind 0)))))


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

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

Input:
(ct-let nil
  :key
  nil)

Output: (defmacro CT-LET ...)

(cond
 (*within-captured-dynenv*
  (let ()
    (let ((#:new-var-space161
           (reduce
            (lambda (#:accum162 #:item163)
              (destructuring-bind
                  (#:name164 . #:value165)
                  #:item163
                (update-alist #:name164 #:value165 #:accum162)))
            (list) :initial-value *var-space*)))
      `(symbol-macrolet ((var-space ,#:new-var-space161))
         ,(let ((*var-space* #:new-var-space161))
            :key
            nil)))))
 (t
  (error
   "No macrodynamic environment has been captured to establish CT-LET bindings.")))


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

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

Input: (destructuring-case nil)

Output: (defmacro DESTRUCTURING-CASE ...)


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

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

Input: (defmacro nil ())

Output: (defmacro DEFMACRO ...)

(progn
 (eval-when (:compile-toplevel)
   (sb-c::%compiler-defmacro :macro-function 'nil))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (sb-c::%defmacro 'nil
                    (sb-int:named-lambda (macro-function nil)
                        (#:expr #:env)
                      (declare (sb-c::lambda-list nil))
                      (declare (ignore #:env))
                      (sb-int:named-ds-bind (:macro nil . defmacro)
                          nil
                          (cdr #:expr)
                        (declare (sb-c::constant-value))))
                    (sb-c:source-location))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(pop-preprocessor-directive-token token-list directive-symbol :errorp nil)

Issue: Macro call that should be transformed by pop-preprocessor-directive-token

Input: (pop-preprocessor-directive-token token-list directive-symbol :errorp nil)

Output:
(defmacro pop-preprocessor-directive-token (token-list directive-name &key (errorp t))
  "Pops the next token in TOKEN-LIST ignoring `+whitespace-marker+'"
  (with-gensyms (head_)
    `(let ((,head_
             (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)))
       (if (eq +whitespace-marker+ ,head_)
           (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)
           ,head_))))

(let ((#:head_263 (check-and-pop-pp-directive-token-1 token-list directive-symbol nil))) (if (eq +whitespace-marker+ #:head_263) (check-and-pop-pp-directive-token-1 token-list directive-symbol nil) #:head_263))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (<= (length s) 2))

Issue: Macro call that should be transformed by is

Input: (is (<= (length s) 2))

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 ((#:e256 (length s)) (#:a257 2)) (if (progn (<= #:e256 #:a257)) (add-result (quote test-passed) :test-expr (quote (<= (length s) 2))) (process-failure (quote (<= (length s) 2)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote 2) #:a257 (quote <=) #:e256)))


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

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

Input: (continue-whopper nil nil)

Output: (defmacro CONTINUE-WHOPPER ...)

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


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

Problem: Macro call that should be transformed by WITH-LOCAL-READTABLE

Input:
(with-local-readtable
  nil
  nil)

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

(bind ((*readtable* (copy-readtable *readtable*)))
  nil
  nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))

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

Input: (with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))

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 :cyan :gray) (eq :cyan :grey) (eq :cyan +gray+) (eq :cyan +grey+)) (with-gray stream (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count)) (cl-ansi-text:with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))) (progn (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite sixth (expr) `(cadr (cddddr ,(second expr))))

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

Input: (define-modf-rewrite sixth (expr) `(cadr (cddddr ,(second expr))))

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defclass/a dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store)))

Problem: Macro call that should be transformed by defclass/a

Input: (defclass/a dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store)))

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

(progn (defclass dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store))) (deftype <dbd-sqlite3-query> nil (quote dbd-sqlite3-query)) (setf (find-class (quote <dbd-sqlite3-query>)) (find-class (quote dbd-sqlite3-query))))


Instruction:
Generate a defmacro form that transforms code like this:
(bind (((:struct metabang-bind-test-1- (my-a a) c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (list c my-a))

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

Input: (bind (((:struct metabang-bind-test-1- (my-a a) c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (list c my-a))

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

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

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

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

(let* ((#:|values-190| (make-metabang-bind-test-1 :a 1 :b 2 :c 3)) (my-a (metabang-bind-test-1-a #:|values-190|)) (c (metabang-bind-test-1-c #:|values-190|))) (declare (ignorable #:|values-190|)) (progn (list c my-a)))


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

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

Input: (js nil (progn))

Output: (defmacro JS ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-yield-binds (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by #'cddr collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type 'fields-clause) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key #'scoped-clause-clause :test #'equalp :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) #'scoped-merging-yield) scoped-clauses :initial-value nil)))))

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

Input: (with-yield-binds (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by #'cddr collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type 'fields-clause) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key #'scoped-clause-clause :test #'equalp :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) #'scoped-merging-yield) scoped-clauses :initial-value nil)))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by (function cddr) collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type (quote fields-clause)) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key (function scoped-clause-clause) :test (function equalp) :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) (function scoped-merging-yield)) scoped-clauses :initial-value nil))))) (loop for bind in (reverse *bind-values*) append bind)))


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

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

Input: (c-assert (member self (kids (fm-parent 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 (member self (kids (fm-parent self))) (c-break "failed assertion: ~a" (quote (member self (kids (fm-parent self)))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:div (:textarea "123")))

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

Input: (with-html-string (:div (:textarea "123")))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-yield (do-generator (x (list->generator data)) (yield x)))

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

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

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

(let (#:g141 #:g142) (with-call/cc (labels ((yield (&rest values) (setf #:g142 values) (let/cc k (setf #:g141 k)))) (do-generator (x (list->generator data)) (yield x)) (setf #:g141 nil))) (gen-lambda nil (cond ((null #:g141) (quote generator-stop)) (t (let ((current #:g142)) (funcall #:g141 nil) (apply (function values) (funcall values-handler current)))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-decoder-simple-list-semantics (let ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))

Problem: Macro call that should be transformed by with-decoder-simple-list-semantics

Input: (with-decoder-simple-list-semantics (let ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))

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 ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-iterators ((it1 seq1 :start start1 :end end1 :from-end from-end) (it2 seq2 :start start2 :end end2 :from-end from-end)) (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (cl:incf pos)))))

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

Input: (with-iterators ((it1 seq1 :start start1 :end end1 :from-end from-end) (it2 seq2 :start start2 :end end2 :from-end from-end)) (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (cl:incf pos)))))

Output:
(defmacro with-iterators (seqs &body forms &environment env)
  "Create static iterators for one or more sequence.

   This macro attempts to determine the type of each sequence, and calls
   MAKE-DOSEQ to generate optimal static iterator code for the given
   sequence types, rather than creating dynamic iterator objects.

   SEQS:

     A list where each element is of the form (ITER SEQUENCE . ARGS)
     where ITER is a symbol identifying the iterator for the sequence,
     SEQUENCE is the form which evaluates to a sequence, and ARGS are
     the remaining iteration arguments, interpreted as they are to the
     ITERATOR function.

     Each iterator identifier (ITER) can be passed to
     WITH-ITER-VALUE, within the body forms of WITH-ITERATORS, to
     retrieve the values of the elements of the sequence.

     The iterator identifiers are in a namespace of their own that is
     they do not name lexical variables/symbol-macros nor functions/macros.

   FORMS:

     A list of forms evaluated in an implicit TAGBODY, thus symbols
     are interpreted as tag names.

     The WITH-ITER-VALUE macro can be used, within FORMS, to retrieve
     the current element of the sequence and advance the iterator to
     the next position.

     The WITH-ITER-PLACE macro can be used, within FORMS, both to
     retrieve and set the value of the current element of the
     sequence, and advance the iterator to the next position.

     NOTE: The value of the last form is not returned, due to it being
     evaluated in a TAGBODY, instead NIL is returned. RETURN-FROM, to
     an outer BLOCK, should be used to return a value from this form.

     NOTE: Whilst the intended use of WITH-ITERATORS is to implement
     iteration macros, such as DOSEQ, the FORMS are only evaluated
     once. It is up to the user to implement the actual loop, using
     the provided TAGBODY facility."

  (with-gensyms (end-tag)
    (labels ((expand-doseq (seq args body env)
               (-> (nth-form-type seq env)
                   (make-doseq seq args end-tag body env)
                   multiple-value-list))

             (make-form (bindings get-values places body)
               (->> (make-macros get-values places body)
                    (make-bindings bindings)))

             (make-macros (get-values places body)
               `(symbol-macrolet
                    ((iter-value-macros
                      ,(append get-values (iter-value-macros env)))

                     (iter-place-macros
                      ,(append places (iter-place-macros env))))

                  ,@body))

             ;; Tagbody

             (make-tagbody (body)
               `((tagbody
                    ,@body
                    ,end-tag)))

             ;; Bindings

             (make-bindings (bindings body)
               (loop
                  for binding in bindings
                  for (init constant?) = (multiple-value-list (make-binding binding))
                  if constant? collect init into constants
                  else collect init into vars
                  finally
                    (return
                      `(symbol-macrolet ,constants
                         (let* ,vars ,body)))))

             (make-binding (binding)
               (destructuring-bind (var init &key constant) binding
                 (if constant
                     (multiple-value-bind (value constant?)
                         (constant-form-value init env)

                       (values
                        `(,var ,value)
                        constant?))

                     (values
                      `(,var ,init)
                      nil)))))

      (loop
         for (var seq . args) in seqs
         for (bindings body value place) =
           (expand-doseq seq args (make-tagbody forms) env) then
           (expand-doseq seq args form-body env)

         for iter-value = (gensym "ITER-VALUE")
         for iter-place = (gensym "ITER-PLACE")
         for form-body = `((macrolet ((,iter-value ,@value)
                                      (,iter-place
                                          ,@(or place
                                                `((&rest args)
                                                  (declare (ignore args))
                                                  (error "In WITH-ITER-PLACE: Iterator ~s points to immutable sequence." ',var)))))
                             ,@body))

         append bindings into all-bindings
         collect (cons var iter-value) into get-values
         collect (cons var iter-place) into places

         finally
           (return
             (make-form all-bindings get-values places form-body))))))

(symbol-macrolet nil (let* ((#:it165 (iterator seq1 :start start1 :end end1 :from-end from-end)) (#:it168 (iterator seq2 :start start2 :end end2 :from-end from-end))) (symbol-macrolet ((iter-value-macros ((it1 . #:iter-value166) (it2 . #:iter-value169))) (iter-place-macros ((it1 . #:iter-place167) (it2 . #:iter-place170)))) (macrolet ((#:iter-value169 (pattern &body body) (symbol-macrolet ((it (quote #:it168)) (tag (quote #:end-tag164))) (with-destructure-pattern (var pattern) (body decl body) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) (let ((#S(sb-impl::comma :expr var :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl :kind 2) (advance #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr body :kind 2))))))) (#:iter-place170 (name more? &body body) (symbol-macrolet ((it (quote #:it168)) (tag (quote #:end-tag164))) (let ((body (sb-int:quasiquote (prog1 (progn #S(sb-impl::comma :expr body :kind 2)) (advance #S(sb-impl::comma :expr it :kind 0)))))) (with-variable-declarations ((decl-name name) (decl-more? more?)) forms body (sb-int:quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr name :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl-name :kind 2) #S(sb-impl::comma :expr (if more? (sb-int:quasiquote (let ((#S(sb-impl::comma :expr more? :kind 0) (not (endp #S(sb-impl::comma :expr it :kind 0))))) #S(sb-impl::comma :expr decl-more? :kind 2) #S(sb-impl::comma :expr forms :kind 0))) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) #S(sb-impl::comma :expr forms :kind 0)))) :kind 0)))))))) (macrolet ((#:iter-value166 (pattern &body body) (symbol-macrolet ((it (quote #:it165)) (tag (quote #:end-tag164))) (with-destructure-pattern (var pattern) (body decl body) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) (let ((#S(sb-impl::comma :expr var :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl :kind 2) (advance #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr body :kind 2))))))) (#:iter-place167 (name more? &body body) (symbol-macrolet ((it (quote #:it165)) (tag (quote #:end-tag164))) (let ((body (sb-int:quasiquote (prog1 (progn #S(sb-impl::comma :expr body :kind 2)) (advance #S(sb-impl::comma :expr it :kind 0)))))) (with-variable-declarations ((decl-name name) (decl-more? more?)) forms body (sb-int:quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr name :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl-name :kind 2) #S(sb-impl::comma :expr (if more? (sb-int:quasiquote (let ((#S(sb-impl::comma :expr more? :kind 0) (not (endp #S(sb-impl::comma :expr it :kind 0))))) #S(sb-impl::comma :expr decl-more? :kind 2) #S(sb-impl::comma :expr forms :kind 0))) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) #S(sb-impl::comma :expr forms :kind 0)))) :kind 0)))))))) (tagbody (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (incf pos)))) #:end-tag164))))))


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

Issue: Macro call that should be transformed by MATRIX-ECASE

Input: (matrix-ecase 'some-name)

Output: (defmacro MATRIX-ECASE ...)


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

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

Input: (-<> nil)

Output: (defmacro -<> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(modf place new-value)

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

Input: (modf place new-value)

Output:
(defmacro modf (place value &rest more &environment env)
  "Make a new object \(which may use some of the old object) such that PLACE
evaluates to VALUE.

MORE should have the form...

MORE : NIL
     | (TEMPORARY-BINDING ANOTHER-MODF-PLACE ANOTHER-VALUE . MORE)

Use it to specify a temporary binding for the new object created which will be
used in the subsequence MODF-PLACE NEW-VALUE pairs until the end of the MODF
form."
  (if more
      (destructuring-bind (next-symbol next-place next-value &rest next-more) more
        `(let ((,next-symbol ,(modf-expand value place nil env)))
           (modf ,next-place ,next-value ,@next-more)))
      (modf-expand value place nil env)))


Instruction:
Generate a defmacro form that transforms code like this:
(fgather-result nil)

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

Input: (fgather-result nil)

Output: (defmacro FGATHER-RESULT ...)


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

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

Input:
(defmacro+ps nil
    nil)

Output: (defmacro DEFMACRO+PS ...)

(progn
 (defmacro nil ())
 (defpsmacro nil
     nil))


Instruction:
Generate a defmacro form that transforms code like this:
(awhen (not (incf x)) t)

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

Input: (awhen (not (incf x)) t)

Output:
(defmacro awhen (test &body body)
  "Like WHEN, except binds the result of the test to IT (via LET) for the scope
of the body."
  `(anaphoric when ,test ,@body))


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

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

Input: (collect-ignore nil)

Output: (defmacro COLLECT-IGNORE ...)

(common-lisp:let* ((#:generator-169 (generator nil)))
  (declare (type generator #:generator-169))
  (tagbody #:ll-170 (next-in #:generator-169 (go end)) (go #:ll-170) end)
  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:
Create a Common Lisp macro for the following transformation. Before code:
(gen-lambda () (if (not data) 'generator-stop (prog1 data (setf data (cdr data)))))

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

Input: (gen-lambda () (if (not data) 'generator-stop (prog1 data (setf data (cdr data)))))

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

(let ((values-handler (create-values-handler))) (declare (ignorable values-handler)) (make-instance (quote basic-generator) :function (lambda nil (if (not data) (quote generator-stop) (prog1 data (setf data (cdr data)))))))