Instruction:
Define a macro that eliminates this repetitive pattern:
(bind (((:flet constant (x)) (declare (ignore x)) 42)) (ensure-same (constant 1) 42))

Issue: Macro call that should be transformed by bind

Input: (bind (((:flet constant (x)) (declare (ignore x)) 42)) (ensure-same (constant 1) 42))

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

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

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

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

(flet ((constant (x) (declare (ignore x)) (progn 42))) (progn (ensure-same (constant 1) 42)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-yield-binds (format nil "~A ~{~A~^, ~}" (sql-clause-name clause) (mapcar #'yield (expression-list-clause-expressions clause))))

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

Input: (with-yield-binds (format nil "~A ~{~A~^, ~}" (sql-clause-name clause) (mapcar #'yield (expression-list-clause-expressions clause))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~{~A~^, ~}" (sql-clause-name clause) (mapcar (function yield) (expression-list-clause-expressions clause)))) (loop for bind in (reverse *bind-values*) append bind)))


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

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

Input: (is (= 1 (length (remove-if-not #'test-failure-p results))))

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

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

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

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-decoder-simple-list-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (caar x)) (find-package :json-test))))

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

Input: (with-decoder-simple-list-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (caar x)) (find-package :json-test))))

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) (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (caar x)) (find-package :json-test))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(dispatch-concurrently ,flow-context ,flow-list)))

Problem: Macro call that should be transformed by with-flow-let-macro

Input: (with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(dispatch-concurrently ,flow-context ,flow-list)))

Output:
(defmacro with-flow-let-macro ((var flow) &body body)
  `(with-gensyms (,var)
     `(let ((,,var (list ,@,flow)))
        ,,@body)))

(with-gensyms (flow-list) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr flow-list :kind 0) (list #S(sb-impl::comma :expr flow :kind 2)))) #S(sb-impl::comma :expr (flow-lambda-macro (flow-context) (sb-int:quasiquote (dispatch-concurrently #S(sb-impl::comma :expr flow-context :kind 0) #S(sb-impl::comma :expr flow-list :kind 0)))) :kind 0))))


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

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

Input: (collect-min nil (progn))

Output: (defmacro COLLECT-MIN ...)

(common-lisp:let* ((#:generator-299 (generator (progn)))
                   #:items-289
                   (#:generator-297 (generator nil))
                   #:numbers-288
                   (#:number-291 nil)
                   #:result-292)
  (declare (type generator #:generator-299)
           (type generator #:generator-297)
           (type (null-or t) #:result-292))
  (tagbody
   #:ll-300
    (setq #:items-289 (next-in #:generator-299 (go end)))
    (setq #:numbers-288 (next-in #:generator-297 (go end)))
    (if (or (null #:number-291) (> #:number-291 #:numbers-288))
        (setq #:number-291 #:numbers-288
              #:result-292 #:items-289))
    (go #:ll-300)
   end)
  (if (null #:number-291)
      (setq #:result-292 nil))
  #:result-292)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(make-instance* 'class (a b c) nil)

What needs to change: Macro call that should be transformed by make-instance*

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

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

Conveniences:

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

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

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

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

Examples:

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

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

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

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

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

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

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

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

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


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

Issue: Macro call that should be transformed by DLET*

Input: (dlet* 'some-name)

Output: (defmacro DLET* ...)


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

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

Input:
(defgeneric* nil
    nil)

Output: (defmacro DEFGENERIC* ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(match '(:name \"John\" :age 23) ((plist :name \"John\" :age age) age)) => 23"))

Issue: Macro call that should be transformed by match

Input: (match '(:name \"John\" :age 23) ((plist :name \"John\" :age age) age)) => 23"))

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

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

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

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

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

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

will be translated to

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

Examples:

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

(let ((#:var153 (quote (:name |"JOHN"| :age 23)))) (declare (ignorable #:var153)) (%or (%if (plistp #:var153) (let ((#:g154 (plistname #:var153)) (#:g155 (plistage #:var153))) (declare (ignorable #:g154 #:g155)) (%or (let ((age #:g155)) (let ((|"JOHN"| #:g154)) age)) (fail))) (fail)) nil))


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

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

Input: (incf 'some-name)

Output: (defmacro INCF ...)

(let* ((#:some-name199 some-name) (#:new198 (+ 1 '#:some-name199)))
  (funcall #'(setf quote) #:new198 #:some-name199))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (node-slot shared) (del-proxy shared))

Problem: Macro call that should be transformed by when

Input: (when (node-slot shared) (del-proxy shared))

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

(if (node-slot shared) (del-proxy shared))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defhandler return-from (return-from name &optional (value nil value-p)) `(list ',return-from ',name ,@(when value-p `(,(e value)))))

Issue: Macro call that should be transformed by defhandler

Input: (defhandler return-from (return-from name &optional (value nil value-p)) `(list ',return-from ',name ,@(when value-p `(,(e value)))))

Output:
(defmacro defhandler (symbol lambda-list &body body)
  (let ((syms (force-list symbol)))
    (let ((func (intern (format nil "~A~A" 'hander- (first syms)))))
      `(progn
         (defun ,func ,lambda-list
           ,@body)
         (setf
          ,@(loop for sym in syms
               collect `(gethash ',sym *form-handler*)
               collect `',func))))))

(progn (defun hander-return-from (return-from name &optional (value nil value-p)) (sb-int:quasiquote (list (quote #S(sb-impl::comma :expr return-from :kind 0)) (quote #S(sb-impl::comma :expr name :kind 0)) #S(sb-impl::comma :expr (when value-p (sb-int:quasiquote (#S(sb-impl::comma :expr (e value) :kind 0)))) :kind 2)))) (setf (gethash (quote return-from) *form-handler*) (quote hander-return-from)))


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

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

Input:
(ct-let* nil
  (progn))

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

(cond (*within-captured-dynenv* (progn (progn)))
      (t
       (error
        "No macrodynamic environment has been captured to establish CT-LET* bindings.")))


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

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

Input:
(product-of nil
  nil)

Output: (defmacro PRODUCT-OF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-csv-output-stream (csv-stream stream) (iter (for row in rows-of-items) (write-csv-row row :stream csv-stream)) (unless stream (get-output-stream-string csv-stream)))

Problem: Macro call that should be transformed by with-csv-output-stream

Input: (with-csv-output-stream (csv-stream stream) (iter (for row in rows-of-items) (write-csv-row row :stream csv-stream)) (unless stream (get-output-stream-string csv-stream)))

Output:
(defmacro with-csv-output-stream ((name inp) &body body)
  (alexandria:with-unique-names (opened?)
    `(multiple-value-bind (,name ,opened?) (%out-stream ,inp)
      (flet ((body () ,@body))
        (unwind-protect (body)
          (when (and ,name ,opened?)
            (close ,name)))))))

(multiple-value-bind (csv-stream #:opened?198) (%out-stream stream) (flet ((body nil (iter (for row in rows-of-items) (write-csv-row row :stream csv-stream)) (unless stream (get-output-stream-string csv-stream)))) (unwind-protect (body) (when (and csv-stream #:opened?198) (close csv-stream)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(dflet ((bar/mock (string) (cond ((equalp string "Hello, World!") 42)))) (is (eql 43 (foo/mock))) (is (eql 43 (foo/mock "HELLO, WORLD!"))))

Issue: Macro call that should be transformed by dflet

Input: (dflet ((bar/mock (string) (cond ((equalp string "Hello, World!") 42)))) (is (eql 43 (foo/mock))) (is (eql 43 (foo/mock "HELLO, WORLD!"))))

Output:
(defmacro dflet ((&rest definitions) &body body)
  "Like FLET, but dynamically sets the FDEFINITIONS during the duration of
the BODY."
  `(progf
       ',(mapcar #'car definitions)
       (list
        ,.(mapcar (lambda (definition)
                    `(lambda ,(cadr definition)
                       ,@(cddr definition)))
                  definitions))
     ,@body))

(progf (quote (bar/mock)) (list (lambda (string) (cond ((equalp string "Hello, World!") 42)))) (is (eql 43 (foo/mock))) (is (eql 43 (foo/mock "HELLO, WORLD!"))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-reader-syntax (set) (let ((set (er "#{'a 'b 1 '(1) '(1) :test #'equal}"))) (is-true (alexandria:setp set)) (is-true (member 'a set)) (is-true (member 'b set)) (is-true (member 1 set)) (is-false (member 2 set)) (is (= 1 (count '(1) set :test #'equal)))))

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

Input: (with-reader-syntax (set) (let ((set (er "#{'a 'b 1 '(1) '(1) :test #'equal}"))) (is-true (alexandria:setp set)) (is-true (member 'a set)) (is-true (member 'b set)) (is-true (member 1 set)) (is-false (member 2 set)) (is (= 1 (count '(1) set :test #'equal)))))

Output:
(defmacro with-reader-syntax (reader-macro-identifiers &body body)
  "This macro is only made for use by read-and-eval functionality,
and rather directed towards tests than users. So, do not export."
  (let ((identifiers (loop :for identifier :in reader-macro-identifiers
                           :collect `(quote ,identifier))))
    `(let ((*array-function*         'make-t-array-from-initial-contents)
           (*hash-table-function*    'alexandria:plist-hash-table)
           (*get-val-function*       'get-val)
           (*get-val-array-function* 'cl:aref)
           (*set-function*           'cl:remove-duplicates)
           (*alists-are-lists*       nil)
           (*plists-are-lists*       nil)
           (*readtable*             (%enable-reader-syntax *readtable* ,@identifiers)))
       ,@body)))

(let ((*array-function* (quote make-t-array-from-initial-contents)) (*hash-table-function* (quote alexandria:plist-hash-table)) (*get-val-function* (quote get-val)) (*get-val-array-function* (quote aref)) (*set-function* (quote remove-duplicates)) (*alists-are-lists* nil) (*plists-are-lists* nil) (*readtable* (%enable-reader-syntax *readtable* (quote set)))) (let ((set (er "#{'a 'b 1 '(1) '(1) :test #'equal}"))) (is-true (alexandria:setp set)) (is-true (member (quote a) set)) (is-true (member (quote b) set)) (is-true (member 1 set)) (is-false (member 2 set)) (is (= 1 (count (quote (1)) set :test (function equal))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(scond ((= 1 2) :no!))

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

Input: (scond ((= 1 2) :no!))

Output:
(defmacro scond (&body clauses)
  "Like COND, except each test-form is bound to IT (via SYMBOL-MACROLET) for the
scope of the corresponsing clause. IT can be set with SETF."
  (labels ((rec (clauses)
	     (if clauses
		 (destructuring-bind ((test &body body) . rest) clauses
		   (if body
		       `(symbolic if ,test (progn ,@body) ,(rec rest))
		       `(symbolic if ,test it ,(rec rest))))
		 nil)))
    (rec clauses)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defvar-unbound *pair-level* "")

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

Input: (defvar-unbound *pair-level* "")

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

(eval-when (:load-toplevel :compile-toplevel :execute) (defvar *pair-level*) (setf (documentation (quote *pair-level*) (quote variable)) ""))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(match maybe m ((just x) (funcall f x)) (nothing nothing))

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

Input: (match maybe m ((just x) (funcall f x)) (nothing nothing))

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

Each clause must have the following syntax:

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

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

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

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

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

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

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

(let ((#:obj-148 m)) (check-type #:obj-148 maybe) (etypecase #:obj-148 (just (with-data (just x) #:obj-148 (funcall f x))) (nothing (with-data (nothing) #:obj-148 nothing))))


Instruction:
Generate a defmacro form that transforms code like this:
(slet (car x) (incf it) (values it x))

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

Input: (slet (car x) (incf it) (values it x))

Output:
(defmacro slet (form &body body)
  "Binds the FORM to IT (via SYMBOL-MACROLET) in the scope of the BODY. IT can
be set with SETF."
  `(symbolic ignore-first ,form (progn ,@body)))

(symbolic ignore-first (car x) (progn (incf it) (values it x)))


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

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

Input: (defpackage nil 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:
Write a Common Lisp macro to handle this code pattern:
(dotimes (quote some-name))

Problem: Macro call that should be transformed by DOTIMES

Input: (dotimes (quote some-name))

Output: (defmacro DOTIMES ...)

(do ((quote 0 (1+ quote))
     (#:g163 (the integer some-name)))
    ((>= quote #:g163) nil)
  (declare (type unsigned-byte quote)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-value-binding as ((var value) value) (declare (ignorable value)) (values NIL var))

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

Input: (define-value-binding as ((var value) value) (declare (ignorable value)) (values NIL var))

Output:
(defmacro define-value-binding (name (var &rest args) &body body)
  (let ((vars (lambda-fiddle:extract-lambda-vars (lambda-fiddle:remove-aux-part args))))
    (emit-binding-definition name var args body :extra-vars vars)))

(define-direct-binding as (var value) (let ((#:value132 (gensym #A((5) base-char . "VALUE")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:value132 value) (loop for #:var131 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var131 #:value132))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:value132 :kind 0)))) #S(sb-impl::comma :expr nil :kind 0))) (let ((value #:value132)) (declare (ignorable value)) (declare (ignorable value)) (values nil var)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause optimizing (form &key (test ''>) saving in) "Finds the optimum value of an expression across the iteration. Refer to the manual for details." (let* ((candidate (gensym "CANDIDATE-MAX")) (test-form `(funcall ,test ,candidate ,*iteration-variable*)) (saving (ensure-list saving)) (in (ensure-list in))) (when (not (= (length saving) (length in))) (error ":saving and :in have different lengths!")) (list* (make-simple-iteration :init form) (make-epilogue :form `(let ((,candidate ,form)) (when ,test-form (setf ,*iteration-variable* ,candidate ,@(loop :for x :in saving :for y :in in :collect y :collect x))))) (loop :for x :in saving :for y :in in :collect (make-simple-iteration :var y :init x)))))

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

Input: (defclause optimizing (form &key (test ''>) saving in) "Finds the optimum value of an expression across the iteration. Refer to the manual for details." (let* ((candidate (gensym "CANDIDATE-MAX")) (test-form `(funcall ,test ,candidate ,*iteration-variable*)) (saving (ensure-list saving)) (in (ensure-list in))) (when (not (= (length saving) (length in))) (error ":saving and :in have different lengths!")) (list* (make-simple-iteration :init form) (make-epilogue :form `(let ((,candidate ,form)) (when ,test-form (setf ,*iteration-variable* ,candidate ,@(loop :for x :in saving :for y :in in :collect y :collect x))))) (loop :for x :in saving :for y :in in :collect (make-simple-iteration :var y :init x)))))

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 optimizing (form &key (test (quote (quote >))) saving in) "Finds the optimum value of an expression across the iteration. Refer to the manual for details." (let* ((candidate (gensym "CANDIDATE-MAX")) (test-form (sb-int:quasiquote (funcall #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr candidate :kind 0) #S(sb-impl::comma :expr *iteration-variable* :kind 0)))) (saving (ensure-list saving)) (in (ensure-list in))) (when (not (= (length saving) (length in))) (error ":saving and :in have different lengths!")) (list* (make-simple-iteration :init form) (make-epilogue :form (sb-int:quasiquote (let ((#S(sb-impl::comma :expr candidate :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when #S(sb-impl::comma :expr test-form :kind 0) (setf #S(sb-impl::comma :expr *iteration-variable* :kind 0) #S(sb-impl::comma :expr candidate :kind 0) #S(sb-impl::comma :expr (loop :for x :in saving :for y :in in :collect y :collect x) :kind 2)))))) (loop :for x :in saving :for y :in in :collect (make-simple-iteration :var y :init x))))) (pushnew (quote optimizing) *clauses*))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-html-string (:li :class nil "Hello"))

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

Input: (with-html-string (:li :class nil "Hello"))

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 (:li :class nil "Hello")))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(integer-reader 1)

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

Input: (integer-reader 1)

Output:
(defmacro integer-reader (bytes)
  "Create a function to read integers from a binary stream."
  (let ((bits (* bytes 8)))
    (labels ((return-form (signed)
               (if signed
                   `(if (logbitp ,(1- bits) result)
                        (dpb result (byte ,(1- bits) 0) -1)
                        result)
                   `result))
             (generate-reader (signed)
               `(defun ,(integer-reader-name bytes signed) (socket)
                  (declare (type stream socket)
                           #.*optimize*)
                  ,(if (= bytes 1)
                       `(let ((result (the (unsigned-byte 8) (read-byte socket))))
                          (declare (type (unsigned-byte 8) result))
                          ,(return-form signed))
                       `(let ((result 0))
                          (declare (type (unsigned-byte ,bits) result))
                          ,@(loop :for byte :from (1- bytes) :downto 0
                                  :collect `(setf (ldb (byte 8 ,(* 8 byte))
                                                       result)
                                                  (the (unsigned-byte 8)
                                                       (read-byte socket))))
                          ,(return-form signed))))))
      `(progn
         ;; This causes weird errors on SBCL in some circumstances. Disabled for now.
         ;;         (declaim (inline ,(integer-reader-name bytes t)
         ;;                          ,(integer-reader-name bytes nil)))
         (declaim (ftype (function (t) (signed-byte ,bits))
                         ,(integer-reader-name bytes t)))
         ,(generate-reader t)
         (declaim (ftype (function (t) (unsigned-byte ,bits))
                         ,(integer-reader-name bytes nil)))
         ,(generate-reader nil)))))

(progn (declaim (ftype (function (t) (signed-byte 8)) read-int1)) (defun read-int1 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result (the (unsigned-byte 8) (read-byte socket)))) (declare (type (unsigned-byte 8) result)) (if (logbitp 7 result) (dpb result (byte 7 0) -1) result))) (declaim (ftype (function (t) (unsigned-byte 8)) read-uint1)) (defun read-uint1 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result (the (unsigned-byte 8) (read-byte socket)))) (declare (type (unsigned-byte 8) result)) result)))


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

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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-custom-var (:real *real-handler*) (constantly 0) "Designator for a function of 1 string argument (real token).")

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

Input: (define-custom-var (:real *real-handler*) (constantly 0) "Designator for a function of 1 string argument (real token).")

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 (*real-handler* . :real)) *custom-vars* :test (function equal)) (defvar *real-handler* (constantly 0) "Designator for a function of 1 string argument (real token).")))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(mapcar (lambda (f) `(function ,(force-first f))) bindings)

Problem: Macro call that should be transformed by m

Input: (mapcar (lambda (f) `(function ,(force-first f))) bindings)

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

(mapcar (lambda (f) (sb-int:quasiquote (function #S(sb-impl::comma :expr (force-first f) :kind 0)))) bindings)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(ensure-gethash (car tail) table (cadr tail))

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

Input: (ensure-gethash (car tail) table (cadr tail))

Output:
(defmacro ensure-gethash (key hash-table &optional default)
  "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEFAULT
under key before returning it. Secondary return value is true if key was
already in the table."
  (once-only (key hash-table)
    (with-unique-names (value presentp)
      `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
         (if ,presentp
             (values ,value ,presentp)
             (values (setf (gethash ,key ,hash-table) ,default) nil))))))

(let ((#:n-key-155 (car tail)) (#:n-hash-table-156 table)) (multiple-value-bind (#:value157 #:foundp158) (gethash #:n-key-155 #:n-hash-table-156) (if #:foundp158 (values #:value157 t) (values (setf (gethash #:n-key-155 #:n-hash-table-156) (cadr tail)) nil))))


Instruction:
Generate a defmacro form that transforms code like this:
(make-name-transformer nil :key nil)

Pattern to recognize: Macro call that should be transformed by MAKE-NAME-TRANSFORMER

Input: (make-name-transformer nil :key nil)

Output: (defmacro MAKE-NAME-TRANSFORMER ...)

(lambda (name definition)
  (declare (ignorable definition))
  (concatenate-symbol nil :key nil))


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

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

Input:
(cond->>
  nil
  nil)

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


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

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

Input:
(auto-permute-typecase nil
  (progn))

Output: (defmacro AUTO-PERMUTE-TYPECASE ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-effective-qualifier generic-function qualifier (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body)))

Issue: Macro call that should be transformed by with-effective-qualifier

Input: (with-effective-qualifier generic-function qualifier (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body)))

Output:
(defmacro with-effective-qualifier (gf-name qualifier &body body)
  "take generic function and a symbol bound to a qualifier and mask that symbol with the effective qualifier.

The effective qualifier is the default qualifier for the given generic function should there be one defined by
a define-hook-generic form."
  `(let ((,qualifier
          (effective-qualifier ,gf-name ,qualifier)))
     ,@body))

(let ((qualifier (effective-qualifier generic-function qualifier))) (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-reader-syntax (get-val array hash-table) (with-output-to-string (*error-output*) (is (char= #\a (er "(with-env [str 0])"))) (is (eq 'a (er "(with-env [vec 0])"))) (is (= 3 (er "(with-env [arr 0 2])"))) (is (eq 'd (er "(with-env [list 3])"))) (is (eq 'b (er "(with-env [ht 'a])"))) (is (eq nil (er "(with-env [ht-eq (string (alexandria:copy-array \"a\"))])"))) (is (equal "b" (er "(with-env [ht-equalp (copy-list '(4 5 6))])"))) (is (= 1 (er "(with-env [assoc-list 'a])"))) (is (eq nil (er "(with-env [assoc-list 'c])"))) (is (= 5 (er "(with-env [plist :c])"))) (is (eq nil (er "(with-env [plist :e])"))) (is (eq 3 (er "(with-env [clos-object 'a])"))) (is (eq 3 (er "(with-env [struct 'a])")))))

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

Input: (with-reader-syntax (get-val array hash-table) (with-output-to-string (*error-output*) (is (char= #\a (er "(with-env [str 0])"))) (is (eq 'a (er "(with-env [vec 0])"))) (is (= 3 (er "(with-env [arr 0 2])"))) (is (eq 'd (er "(with-env [list 3])"))) (is (eq 'b (er "(with-env [ht 'a])"))) (is (eq nil (er "(with-env [ht-eq (string (alexandria:copy-array \"a\"))])"))) (is (equal "b" (er "(with-env [ht-equalp (copy-list '(4 5 6))])"))) (is (= 1 (er "(with-env [assoc-list 'a])"))) (is (eq nil (er "(with-env [assoc-list 'c])"))) (is (= 5 (er "(with-env [plist :c])"))) (is (eq nil (er "(with-env [plist :e])"))) (is (eq 3 (er "(with-env [clos-object 'a])"))) (is (eq 3 (er "(with-env [struct 'a])")))))

Output:
(defmacro with-reader-syntax (reader-macro-identifiers &body body)
  "This macro is only made for use by read-and-eval functionality,
and rather directed towards tests than users. So, do not export."
  (let ((identifiers (loop :for identifier :in reader-macro-identifiers
                           :collect `(quote ,identifier))))
    `(let ((*array-function*         'make-t-array-from-initial-contents)
           (*hash-table-function*    'alexandria:plist-hash-table)
           (*get-val-function*       'get-val)
           (*get-val-array-function* 'cl:aref)
           (*set-function*           'cl:remove-duplicates)
           (*alists-are-lists*       nil)
           (*plists-are-lists*       nil)
           (*readtable*             (%enable-reader-syntax *readtable* ,@identifiers)))
       ,@body)))

(let ((*array-function* (quote make-t-array-from-initial-contents)) (*hash-table-function* (quote alexandria:plist-hash-table)) (*get-val-function* (quote get-val)) (*get-val-array-function* (quote aref)) (*set-function* (quote remove-duplicates)) (*alists-are-lists* nil) (*plists-are-lists* nil) (*readtable* (%enable-reader-syntax *readtable* (quote get-val) (quote array) (quote hash-table)))) (with-output-to-string (*error-output*) (is (char= #\LATIN_SMALL_LETTER_A (er "(with-env [str 0])"))) (is (eq (quote a) (er "(with-env [vec 0])"))) (is (= 3 (er "(with-env [arr 0 2])"))) (is (eq (quote d) (er "(with-env [list 3])"))) (is (eq (quote b) (er "(with-env [ht 'a])"))) (is (eq nil (er "(with-env [ht-eq (string (alexandria:copy-array \"a\"))])"))) (is (equal "b" (er "(with-env [ht-equalp (copy-list '(4 5 6))])"))) (is (= 1 (er "(with-env [assoc-list 'a])"))) (is (eq nil (er "(with-env [assoc-list 'c])"))) (is (= 5 (er "(with-env [plist :c])"))) (is (eq nil (er "(with-env [plist :e])"))) (is (eq 3 (er "(with-env [clos-object 'a])"))) (is (eq 3 (er "(with-env [struct 'a])")))))


Instruction:
Generate a defmacro form that transforms code like this:
(assert-values ("changed foo = 1") (foo 1) (foo+1 2) (bar 'nothing) (bar-1 'nothing))

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

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-simple-definition-resolver source-transform (designator) (cond ((and (listp designator) (eql 'cl:setf (car designator))) (sb-int:info :function :source-transform (second designator))) ((symbolp designator) (sb-int:info :function :source-transform designator))))

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

Input: (define-simple-definition-resolver source-transform (designator) (cond ((and (listp designator) (eql 'cl:setf (car designator))) (sb-int:info :function :source-transform (second designator))) ((symbolp designator) (sb-int:info :function :source-transform designator))))

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

(define-definition-resolver source-transform (source-transform #:package149) (when (ignore-errors (let ((designator source-transform)) (cond ((and (listp designator) (eql (quote setf) (car designator))) (sb-int:info :function :source-transform (second designator))) ((symbolp designator) (sb-int:info :function :source-transform designator))))) (list (make-instance (quote source-transform) :designator source-transform :package #:package149))))


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

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

Input: (with-rules 'some-name)

Output: (defmacro WITH-RULES ...)

(dolist ('some-name (alexandria:hash-table-keys cl-rules.core::*rules*)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(deftag ul* (body attrs &key &allow-other-keys) "<ul> with every form (except <li>) in BODY auto-wrapped into a <li>." `(:ul ,@attrs ,@(loop for form in body when (and (listp form) (eq :li (first form))) collect form else collect `(:li ,form))))

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

Input: (deftag ul* (body attrs &key &allow-other-keys) "<ul> with every form (except <li>) in BODY auto-wrapped into a <li>." `(:ul ,@attrs ,@(loop for form in body when (and (listp form) (eq :li (first form))) collect form else collect `(:li ,form))))

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

(deftag/macro ul* (body attrs &key &allow-other-keys) "<ul> with every form (except <li>) in BODY auto-wrapped into a <li>." (sb-int:quasiquote (:ul #S(sb-impl::comma :expr attrs :kind 2) #S(sb-impl::comma :expr (loop for form in body when (and (listp form) (eq :li (first form))) collect form else collect (sb-int:quasiquote (:li #S(sb-impl::comma :expr form :kind 0)))) :kind 2))))


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

Problem: Macro call that should be transformed by LAMBDA-CORO

Input:
(lambda-coro
  nil)

Output: (defmacro LAMBDA-CORO ...)

(progn
 (defcoroutine #:name125
     (#:arg126)
   (macrolet ((yield (form)
                (let ((g!-it (gensym "IT")))
                  `(progn
                    (let ((,g!-it ,form))
                      (cl-coroutine:yield ,g!-it))
                    ,'#:arg126)))
              (last-yield-value ()
                '#:arg126))
     nil
     (coexit!)))
 (make-coroutine '#:name125))


Instruction:
Define a macro that eliminates this repetitive pattern:
(next-ffi)

Issue: Macro call that should be transformed by next-ffi

Input: (next-ffi)

Output:
(defmacro next-ffi ()
  (with-gensyms (next)
    `(let ((,next (cadr fields)))
       (foreign-to-ffi
        (and ,next (foreign-type ,next))
        (cdr names)
        (cdr params)
        (cdr fields)
        body))))

(let ((#:next192 (cadr fields))) (foreign-to-ffi (and #:next192 (foreign-type #:next192)) (cdr names) (cdr params) (cdr fields) body))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(signal-reader-error "Incomplete regex comment starting with '(#'")

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

Input: (signal-reader-error "Incomplete regex comment starting with '(#'")

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

(error (quote simple-reader-error) :stream *stream* :format-control "Incomplete regex comment starting with '(#'" :format-arguments (list))


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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(gen-lambda-with-sticky-stop () (let ((res (funcall source-func))) (if (funcall predicate res) res (sticky-stop))))

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

Input: (gen-lambda-with-sticky-stop () (let ((res (funcall source-func))) (if (funcall predicate res) res (sticky-stop))))

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

(make-instance (quote basic-generator) :function (sticky-stop-lambda nil (let ((res (funcall source-func))) (if (funcall predicate res) res (sticky-stop)))))


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

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

Input:
(lambda* nil
  :key
  nil)

Output: (defmacro LAMBDA* ...)

(lambda ()
  (with-yield
    :key
    nil))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-gensyms (num items position not-preceded-by string item new-mode until advancing) `(labels ((advance (,num) (setf ,position-place (+ ,position-place ,num)) t) (peek-any (,items &key ,not-preceded-by) (incf *scan-calls*) (let* ((,items (if (stringp ,items) (coerce ,items 'list) ,items)) (,not-preceded-by (if (characterp ,not-preceded-by) (string ,not-preceded-by) ,not-preceded-by)) (,position ,position-place) (,string ,string-param)) (let ((,item (and (< ,position (length ,string)) (find ,string ,items :test #'(lambda (,string ,item) #+nil (format t "looking for ~S in ~S starting at ~S~%" ,item ,string ,position) (if (characterp ,item) (char= (elt ,string ,position) ,item) (search ,item ,string :start2 ,position :end2 (min (length ,string) (+ ,position (length ,item)))))))))) (if (characterp ,item) (setf ,item (string ,item))) (if (if ,item (if ,not-preceded-by (if (>= (- ,position (length ,not-preceded-by)) 0) (not (string= (subseq ,string (- ,position (length ,not-preceded-by)) ,position) ,not-preceded-by)) t) t) nil) ,item (progn (and *reset-position* (setf ,position-place *reset-position*)) nil))))) (scan-any (,items &key ,not-preceded-by) (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by))) (and ,item (advance (length ,item))))) (peek (,item &key ,not-preceded-by) (peek-any (list ,item) :not-preceded-by ,not-preceded-by)) (scan (,item &key ,not-preceded-by) (scan-any (list ,item) :not-preceded-by ,not-preceded-by))) (macrolet ((set-mode (,new-mode &key ,until (,advancing t)) (list 'progn (list 'setf ',mode-place ,new-mode) (list 'setf ',mode-wait-place (list 'lambda (list ',position) (list 'let (list (list '*reset-position* ',position)) (list 'values ,until ,advancing))))))) ,@body)))

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

Input: (with-gensyms (num items position not-preceded-by string item new-mode until advancing) `(labels ((advance (,num) (setf ,position-place (+ ,position-place ,num)) t) (peek-any (,items &key ,not-preceded-by) (incf *scan-calls*) (let* ((,items (if (stringp ,items) (coerce ,items 'list) ,items)) (,not-preceded-by (if (characterp ,not-preceded-by) (string ,not-preceded-by) ,not-preceded-by)) (,position ,position-place) (,string ,string-param)) (let ((,item (and (< ,position (length ,string)) (find ,string ,items :test #'(lambda (,string ,item) #+nil (format t "looking for ~S in ~S starting at ~S~%" ,item ,string ,position) (if (characterp ,item) (char= (elt ,string ,position) ,item) (search ,item ,string :start2 ,position :end2 (min (length ,string) (+ ,position (length ,item)))))))))) (if (characterp ,item) (setf ,item (string ,item))) (if (if ,item (if ,not-preceded-by (if (>= (- ,position (length ,not-preceded-by)) 0) (not (string= (subseq ,string (- ,position (length ,not-preceded-by)) ,position) ,not-preceded-by)) t) t) nil) ,item (progn (and *reset-position* (setf ,position-place *reset-position*)) nil))))) (scan-any (,items &key ,not-preceded-by) (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by))) (and ,item (advance (length ,item))))) (peek (,item &key ,not-preceded-by) (peek-any (list ,item) :not-preceded-by ,not-preceded-by)) (scan (,item &key ,not-preceded-by) (scan-any (list ,item) :not-preceded-by ,not-preceded-by))) (macrolet ((set-mode (,new-mode &key ,until (,advancing t)) (list 'progn (list 'setf ',mode-place ,new-mode) (list 'setf ',mode-wait-place (list 'lambda (list ',position) (list 'let (list (list '*reset-position* ',position)) (list 'values ,until ,advancing))))))) ,@body)))

Output:
(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(mapcar #'(lambda (name)
                     (list name `(make-symbol ,(symbol-name name)))) names)
    ,@body))

(let ((num (gensym #A((3) base-char . "NUM"))) (items (gensym #A((5) base-char . "ITEMS"))) (position (gensym #A((8) base-char . "POSITION"))) (not-preceded-by (gensym #A((15) base-char . "NOT-PRECEDED-BY"))) (string (gensym #A((6) base-char . "STRING"))) (item (gensym #A((4) base-char . "ITEM"))) (new-mode (gensym #A((8) base-char . "NEW-MODE"))) (until (gensym #A((5) base-char . "UNTIL"))) (advancing (gensym #A((9) base-char . "ADVANCING")))) (sb-int:quasiquote (labels ((advance (#S(sb-impl::comma :expr num :kind 0)) (setf #S(sb-impl::comma :expr position-place :kind 0) (+ #S(sb-impl::comma :expr position-place :kind 0) #S(sb-impl::comma :expr num :kind 0))) t) (peek-any (#S(sb-impl::comma :expr items :kind 0) &key #S(sb-impl::comma :expr not-preceded-by :kind 0)) (incf *scan-calls*) (let* ((#S(sb-impl::comma :expr items :kind 0) (if (stringp #S(sb-impl::comma :expr items :kind 0)) (coerce #S(sb-impl::comma :expr items :kind 0) (quote list)) #S(sb-impl::comma :expr items :kind 0))) (#S(sb-impl::comma :expr not-preceded-by :kind 0) (if (characterp #S(sb-impl::comma :expr not-preceded-by :kind 0)) (string #S(sb-impl::comma :expr not-preceded-by :kind 0)) #S(sb-impl::comma :expr not-preceded-by :kind 0))) (#S(sb-impl::comma :expr position :kind 0) #S(sb-impl::comma :expr position-place :kind 0)) (#S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr string-param :kind 0))) (let ((#S(sb-impl::comma :expr item :kind 0) (and (< #S(sb-impl::comma :expr position :kind 0) (length #S(sb-impl::comma :expr string :kind 0))) (find #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr items :kind 0) :test (function (lambda (#S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr item :kind 0)) (if (characterp #S(sb-impl::comma :expr item :kind 0)) (char= (elt #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position :kind 0)) #S(sb-impl::comma :expr item :kind 0)) (search #S(sb-impl::comma :expr item :kind 0) #S(sb-impl::comma :expr string :kind 0) :start2 #S(sb-impl::comma :expr position :kind 0) :end2 (min (length #S(sb-impl::comma :expr string :kind 0)) (+ #S(sb-impl::comma :expr position :kind 0) (length #S(sb-impl::comma :expr item :kind 0)))))))))))) (if (characterp #S(sb-impl::comma :expr item :kind 0)) (setf #S(sb-impl::comma :expr item :kind 0) (string #S(sb-impl::comma :expr item :kind 0)))) (if (if #S(sb-impl::comma :expr item :kind 0) (if #S(sb-impl::comma :expr not-preceded-by :kind 0) (if (>= (- #S(sb-impl::comma :expr position :kind 0) (length #S(sb-impl::comma :expr not-preceded-by :kind 0))) 0) (not (string= (subseq #S(sb-impl::comma :expr string :kind 0) (- #S(sb-impl::comma :expr position :kind 0) (length #S(sb-impl::comma :expr not-preceded-by :kind 0))) #S(sb-impl::comma :expr position :kind 0)) #S(sb-impl::comma :expr not-preceded-by :kind 0))) t) t) nil) #S(sb-impl::comma :expr item :kind 0) (progn (and *reset-position* (setf #S(sb-impl::comma :expr position-place :kind 0) *reset-position*)) nil))))) (scan-any (#S(sb-impl::comma :expr items :kind 0) &key #S(sb-impl::comma :expr not-preceded-by :kind 0)) (let ((#S(sb-impl::comma :expr item :kind 0) (peek-any #S(sb-impl::comma :expr items :kind 0) :not-preceded-by #S(sb-impl::comma :expr not-preceded-by :kind 0)))) (and #S(sb-impl::comma :expr item :kind 0) (advance (length #S(sb-impl::comma :expr item :kind 0)))))) (peek (#S(sb-impl::comma :expr item :kind 0) &key #S(sb-impl::comma :expr not-preceded-by :kind 0)) (peek-any (list #S(sb-impl::comma :expr item :kind 0)) :not-preceded-by #S(sb-impl::comma :expr not-preceded-by :kind 0))) (scan (#S(sb-impl::comma :expr item :kind 0) &key #S(sb-impl::comma :expr not-preceded-by :kind 0)) (scan-any (list #S(sb-impl::comma :expr item :kind 0)) :not-preceded-by #S(sb-impl::comma :expr not-preceded-by :kind 0)))) (macrolet ((set-mode (#S(sb-impl::comma :expr new-mode :kind 0) &key #S(sb-impl::comma :expr until :kind 0) (#S(sb-impl::comma :expr advancing :kind 0) t)) (list (quote progn) (list (quote setf) (quote #S(sb-impl::comma :expr mode-place :kind 0)) #S(sb-impl::comma :expr new-mode :kind 0)) (list (quote setf) (quote #S(sb-impl::comma :expr mode-wait-place :kind 0)) (list (quote lambda) (list (quote #S(sb-impl::comma :expr position :kind 0))) (list (quote let) (list (list (quote *reset-position*) (quote #S(sb-impl::comma :expr position :kind 0)))) (list (quote values) #S(sb-impl::comma :expr until :kind 0) #S(sb-impl::comma :expr advancing :kind 0)))))))) #S(sb-impl::comma :expr body :kind 2)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

Problem: Macro call that should be transformed by lret

Input: (lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

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

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

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

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

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

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

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

(lret-aux let* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-dot nil
  :key
  nil)

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

Input:
(with-dot nil
  :key
  nil)

Output:
(defmacro with-dot (() &body body)
  `(progn ,@(replace-dot-calls body)))


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

Issue: Macro call that should be transformed by DEFGENERIC

Input: (defgeneric nil :key nil)

Output: (defmacro DEFGENERIC ...)

(common-lisp:defgeneric nil
    :key
  nil)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(deferror "22003" numeric-value-out-of-range data-exception)

Problem: Macro call that should be transformed by deferror

Input: (deferror "22003" numeric-value-out-of-range data-exception)

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

(progn (define-condition numeric-value-out-of-range (data-exception) nil) (setf (gethash "22003" *error-table*) (quote numeric-value-out-of-range)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(make-instance* 'class (b c) :x x (when something (list :a a)))

What needs to change: Macro call that should be transformed by make-instance*

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

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

Conveniences:

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

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

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

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

Examples:

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

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

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

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

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

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

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

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

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


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

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

Input:
(none-of nil
  (progn))

Output: (defmacro NONE-OF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(deferror "40003" statement-completion-unknown transaction-rollback)

Problem: Macro call that should be transformed by deferror

Input: (deferror "40003" statement-completion-unknown transaction-rollback)

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

(progn (define-condition statement-completion-unknown (transaction-rollback) nil) (setf (gethash "40003" *error-table*) (quote statement-completion-unknown)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(integer-writer 1)

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

Input: (integer-writer 1)

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-lock (lru-pool-lock pool) (evict-tail pool))

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

Input: (with-lock (lru-pool-lock pool) (evict-tail pool))

Output:
(defmacro with-lock (lock &body body)
  (declare (ignorable lock))
  #+thread-support `(bt2:with-lock-held (,lock)
                      ,@body)
  #-thread-support `(progn ,@body))

(bt2:with-lock-held ((lru-pool-lock pool)) (evict-tail pool))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-active-layers* nil
  :key
  nil)

Write a macro that addresses: Macro call that should be transformed by WITH-ACTIVE-LAYERS*

Input:
(with-active-layers* nil
  :key
  nil)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ematch0 args (nil nil) ((list* '&key rest) (list* '&key (process-keyword-args rest))) ((list* '&aux rest) args) ((list* name rest) (list* name (process-rest-args rest))))

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

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

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

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


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

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

Input: (is-false nil)

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 ((#:value188 nil)) (if #:value188 (process-failure (quote nil) "~S returned the value ~S, which is true" (quote nil) #:value188) (add-result (quote test-passed) :test-expr (quote nil))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-env (setp 2 [plist :c]))

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

Input: (with-env (setp 2 [plist :c]))

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-type-map compiler-macro cl:compiler-macro)

What needs to change: Macro call that should be transformed by define-simple-type-map

Input: (define-simple-type-map compiler-macro cl:compiler-macro)

Output:
(defmacro define-simple-type-map (class type)
  `(defmethod type ((,class ,class))
     ',type))

(defmethod type ((compiler-macro compiler-macro)) (quote common-lisp:compiler-macro))


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

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

Input: (with-generator 'some-name)

Output: (defmacro WITH-GENERATOR ...)

(let ((quote some-name))
  (assert (typep quote 'generator!))
  (unwind-protect (progn) (stop quote)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun/1 atan2 (x y) (atan x y))

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

Input: (defun/1 atan2 (x y) (atan x y))

Output:
(defmacro defun/1 (name arglist &body body)
  "Lisp-1 defun; makes function pointers work."
  `(progn
     (defun ,name ,arglist
       (declare (optimize (speed 0) (debug 3)
                          ;; FIXME: Why do minor warnings result in load errors?
                          #+sbcl (sb-ext:inhibit-warnings 3)))

       ,@body)
     (defparameter ,name (vacietis.c:mkptr& (symbol-function ',name)))))

(progn (defun atan2 (x y) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (atan x y)) (defparameter atan2 (vacietis.c:mkptr& (symbol-function (quote atan2)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(signal-reader-error "No character for char-code #x~X" code)

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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(expand-selector selector)

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

Input: (expand-selector selector)

Output:
(defmacro expand-selector (&rest args)
  `(let ((result ,@args))
     (cond ((typep result 'kv-container) result)
	   ((typep result 'pair)         result)
	   ((null result)                result)
	   (t ($+ result)))))

(let ((result selector)) (cond ((typep result (quote kv-container)) result) ((typep result (quote pair)) result) ((null result) result) (t ($+ result))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-simple-definition-resolver method-combination (designator) (find-method #'sb-mop:find-method-combination nil (list (find-class 'cl:generic-function) `(eql ,designator) T) nil))

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

Input: (define-simple-definition-resolver method-combination (designator) (find-method #'sb-mop:find-method-combination nil (list (find-class 'cl:generic-function) `(eql ,designator) T) nil))

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

(define-definition-resolver method-combination (method-combination #:package143) (when (ignore-errors (let ((designator method-combination)) (find-method (common-lisp:function sb-mop:find-method-combination) nil (list (find-class (quote common-lisp:generic-function)) (sb-int:quasiquote (eql #S(sb-impl::comma :expr designator :kind 0))) t) nil))) (list (make-instance (quote method-combination) :designator method-combination :package #:package143))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-simple-definition-resolver vop (designator) (sb-c::vop-parse-or-lose designator))

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

Input: (define-simple-definition-resolver vop (designator) (sb-c::vop-parse-or-lose designator))

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

(define-definition-resolver vop (vop #:package150) (when (ignore-errors (let ((designator vop)) (sb-c::vop-parse-or-lose designator))) (list (make-instance (quote vop) :designator vop :package #:package150))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-custom-var (:array-element *array-element-handler*))

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

Input: (define-custom-var (:array-element *array-element-handler*))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-symbol-access
  nil)

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

Input:
(with-symbol-access
  nil)

Output: (defmacro WITH-SYMBOL-ACCESS ...)


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

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

Output: (defmacro $ ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'init-accumulator :array-member #'accumulator-add :end-of-array #'accumulator-get-sequence :array-type 'vector :beginning-of-object #'init-accumulator-and-prototype :object-key #'accumulator-add-key-or-set-prototype :object-value #'accumulator-add-value-or-set-prototype :end-of-object #'accumulator-get-object :beginning-of-string #'init-string-stream-accumulator :string-char #'string-stream-accumulator-add :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :object-scope (union *object-scope-variables* '(*prototype* *json-array-type*)) :internal-decoder #'decode-json)

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

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

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(unroll-assignment-ops += -= *= /= %= <<= >>= &= ^= |\|=|)

Write a macro that addresses: Macro call that should be transformed by unroll-assignment-ops

Input: (unroll-assignment-ops += -= *= /= %= <<= >>= &= ^= |\|=|)

Output:
(defmacro unroll-assignment-ops (&rest ops)
  `(progn
     ,@(loop for op in ops collect
            `(defmacro ,(find-symbol (symbol-name op) '#:vacietis.c)
                 (lvalue rvalue)
               `(setf ,lvalue
                      (,',(find-symbol
                           (reverse (subseq (reverse (symbol-name op)) 1))
                           '#:vacietis.c)
                          ,lvalue
                          ,rvalue))))))

(progn (defmacro vacietis.c:+= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:+) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:-= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:-) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:*= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:*) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:/= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:/) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:%= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:%) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:<<= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:<<) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:>>= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:>>) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:&= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:&) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:^= (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:^) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))) (defmacro vacietis.c:|\|=| (lvalue rvalue) (sb-int:quasiquote (setf #S(sb-impl::comma :expr lvalue :kind 0) (#S(sb-impl::comma :expr (quote vacietis.c:|\||) :kind 0) #S(sb-impl::comma :expr lvalue :kind 0) #S(sb-impl::comma :expr rvalue :kind 0))))))


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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-clause always (form &aux (result T)) (values `(unless ,form (setf ,result NIL) (end-for)) result))

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

Input: (define-simple-clause always (form &aux (result T)) (values `(unless ,form (setf ,result NIL) (end-for)) result))

Output:
(defmacro define-simple-clause (name args &body body)
  (multiple-value-bind (args outer-let inner-let result-let) (compute-binding-parts NIL NIL args)
    `(define-direct-clause ,name ,(rest args)
       (let ,outer-let
         (values* `(let* ,(list
                           ,@result-let)
                     (declare (ignorable ,,@(mapcar #'delist outer-let))))
                  (let ,inner-let
                    (declare (ignorable ,@(mapcar #'delist inner-let)))
                    ,@body))))))

(define-direct-clause always (form) (let ((#:result185 (gensym #A((6) base-char . "RESULT")))) (values* (sb-int:quasiquote (let* #S(sb-impl::comma :expr (list (list #:result185 (quote t))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:result185 :kind 0))))) (let ((result #:result185)) (declare (ignorable result)) (values (sb-int:quasiquote (unless #S(sb-impl::comma :expr form :kind 0) (setf #S(sb-impl::comma :expr result :kind 0) nil) (end-for))) result)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-unique-js-names)

Issue: Macro call that should be transformed by WITH-UNIQUE-JS-NAMES

Input: (with-unique-js-names)

Output: (defmacro WITH-UNIQUE-JS-NAMES ...)


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

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

Input: (with-collectors nil)

Output: (defmacro WITH-COLLECTORS ...)


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

Problem: Macro call that should be transformed by THE-PART

Input: (the-part 'some-name)

Output: (defmacro THE-PART ...)


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

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

Input:
(letmatch nil
    (progn))

Output: (defmacro LETMATCH ...)

(ifmatch (nil (progn) nil (error "LETMATCH:  mismatch.")))


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

Problem: Macro call that should be transformed by DEFACTION

Input:
(defaction nil
    nil)

Output: (defmacro DEFACTION ...)

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


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

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

Input: (js-inline nil (progn))

Output: (defmacro JS-INLINE ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))

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

Input: (with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))

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 :yellow :gray) (eq :yellow :grey) (eq :yellow +gray+) (eq :yellow +grey+)) (with-gray stream (format/indent reporter stream "△ Tests were run but no plan was declared.~%")) (cl-ansi-text:with-color (:yellow :stream stream) (format/indent reporter stream "△ Tests were run but no plan was declared.~%"))) (progn (format/indent reporter stream "△ Tests were run but no plan was declared.~%")))


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

Problem: Macro call that should be transformed by DEFPATTERN

Input:
(defpattern nil
    nil)

Output: (defmacro DEFPATTERN ...)

(eval-always
  (setf (get 'nil 'cl-match-pattern)
          (lambda (#:g133)
            (lett nil
                #:g133))))


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

What needs to change: Macro call that should be transformed by LTBDD-WITH-NEW-HASH

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

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

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


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

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

Input:
(->>
  nil
  nil)

Output: (defmacro ->> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-path-instruction-pair smooth-curve-to "S" (control-x2 control-y2 x y))

Pattern to recognize: Macro call that should be transformed by define-path-instruction-pair

Input: (define-path-instruction-pair smooth-curve-to "S" (control-x2 control-y2 x y))

Output:
(defmacro define-path-instruction-pair (name instruction (&rest args))
  (let ((draw-relative (intern (concatenate 'string (string name) "-R"))))
    `(progn
       (defun ,name (,@args)
         (format-instruction ,instruction ,@args))
       (defun ,draw-relative (,@args)
         (format-instruction ,(string-downcase instruction) ,@args)))))

(progn (defun smooth-curve-to (control-x2 control-y2 x y) (format-instruction "S" control-x2 control-y2 x y)) (defun smooth-curve-to-r (control-x2 control-y2 x y) (format-instruction "s" control-x2 control-y2 x y)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-html-string (:p :dataset (:duck (dolomphious) :fish 'fizzgigious :spoon "runcible")))

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

Input: (with-html-string (:p :dataset (:duck (dolomphious) :fish 'fizzgigious :spoon "runcible")))

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 (:p :dataset (:duck (dolomphious) :fish (quote fizzgigious) :spoon "runcible"))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

Problem: Macro call that should be transformed by lret*

Input: (lret* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))

Output:
(defmacro lret* ((&rest bindings) &body body)
  "Cf. `lret'."
  `(lret-aux let* ,bindings
     ,@body))

(lret-aux let* ((offset (- length (length vec))) (element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec :start1 offset) (loop for i from 0 below offset by pad-len do (replace out pad :start1 i :end1 offset)))