Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-value-binding on (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var ,list) (setf ,list (funcall ,by ,list))) `(progn (update ,var ,list) (setf ,list (cdr ,list))))) (T (end-for))))

Problem: Macro call that should be transformed by define-value-binding

Input: (define-value-binding on (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var ,list) (setf ,list (funcall ,by ,list))) `(progn (update ,var ,list) (setf ,list (cdr ,list))))) (T (end-for))))

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 on (var list &key (by nil by-p)) (let ((#:list137 (gensym #A((4) base-char . "LIST"))) (#:by138 (gensym #A((2) base-char . "BY")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:list137 list) (list #:by138 by) (loop for #:var136 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var136 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:list137 :kind 0) #S(sb-impl::comma :expr #:by138 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote list) :kind 0) #S(sb-impl::comma :expr #:list137 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((list #:list137) (by #:by138)) (declare (ignorable list by)) (sb-int:quasiquote (cond (#S(sb-impl::comma :expr list :kind 0) #S(sb-impl::comma :expr (if by-p (sb-int:quasiquote (progn (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr list :kind 0)) (setf #S(sb-impl::comma :expr list :kind 0) (funcall #S(sb-impl::comma :expr by :kind 0) #S(sb-impl::comma :expr list :kind 0))))) (sb-int:quasiquote (progn (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr list :kind 0)) (setf #S(sb-impl::comma :expr list :kind 0) (cdr #S(sb-impl::comma :expr list :kind 0)))))) :kind 0)) (t (end-for))))))))


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

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

Input: (mvlet* nil)

Output: (defmacro MVLET* ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-trace-sql (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))

Issue: Macro call that should be transformed by with-trace-sql

Input: (with-trace-sql (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))

Output:
(defmacro with-trace-sql (&body body)
  `(let ((dbi:*sql-execution-hooks* (cons #'trace-sql
                                          dbi:*sql-execution-hooks*)))
     ,@body))

(let ((*sql-execution-hooks* (cons (function trace-sql) *sql-execution-hooks*))) (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall `#'(lambda (,c) (declare (magic)) ,(cps-convert-progn body c types value? environment)) '() continuation t)))

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

Input: (defun-compile-time cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall `#'(lambda (,c) (declare (magic)) ,(cps-convert-progn body c types value? environment)) '() continuation t)))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall (sb-int:quasiquote (function (lambda (#S(sb-impl::comma :expr c :kind 0)) (declare (magic)) #S(sb-impl::comma :expr (cps-convert-progn body c types value? environment) :kind 0)))) (quote nil) continuation t))) (eval-when (:compile-toplevel) (compile (quote cps-convert-block))))


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

Issue: Macro call that should be transformed by DLETF

Input: (dletf nil)

Output: (defmacro DLETF ...)

(special-symbol-progv (with-symbol-access
                        (list))
    (list)
  (locally (declare (special))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error invalid-symbol-macro-form () (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)

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

Input: (define-error invalid-symbol-macro-form () (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)

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

(defcondition invalid-symbol-macro-form (:error-type varjo-error :prefix "Varjo") (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)


Instruction:
Generate a defmacro form that transforms code like this:
(def-dynenv-fun nil
    :key
  nil)

Pattern to recognize: Macro call that should be transformed by DEF-DYNENV-FUN

Input:
(def-dynenv-fun nil
    :key
  nil)

Output: (defmacro DEF-DYNENV-FUN ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun nil (&rest #:args) (apply (dynenv-function nil) #:args))
  (defvar #:nil145 (lambda :key nil))
  (setf (get 'nil 'dynenv-fun) '#:nil145))


Instruction:
Generate a defmacro form that transforms code like this:
(acond ((+ 2 2) (setf foo 38) (incf foo it) foo) (t nil))

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

Input: (acond ((+ 2 2) (setf foo 38) (incf foo it) foo) (t nil))

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

(let ((#:it (+ 2 2))) (if #:it (let ((it #:it)) (declare (ignorable it)) (setf foo 38) (incf foo it) foo) (acond (t nil))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is (= (* 2 a) (dummy-add a a)))

Problem: Macro call that should be transformed by is

Input: (is (= (* 2 a) (dummy-add a a)))

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 ((#:e164 (* 2 a)) (#:a165 (dummy-add a a))) (if (progn (= #:e164 #:a165)) (add-result (quote test-passed) :test-expr (quote (= (* 2 a) (dummy-add a a)))) (process-failure (quote (= (* 2 a) (dummy-add a a))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (dummy-add a a)) #:a165 (quote =) #:e164)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-error assigning-to-readonly () (var-name) "Assignment failed as ~a is readonly" var-name)

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

Input: (define-error assigning-to-readonly () (var-name) "Assignment failed as ~a is readonly" var-name)

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

(defcondition assigning-to-readonly (:error-type varjo-error :prefix "Varjo") (var-name) "Assignment failed as ~a is readonly" var-name)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (cdr head) (cons 'progn (cdr head)))

Problem: Macro call that should be transformed by when

Input: (when (cdr head) (cons 'progn (cdr head)))

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

(if (cdr head) (cons (quote progn) (cdr head)))


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

Issue: Macro call that should be transformed by WHEN

Input: (when nil (progn))

Output: (defmacro WHEN ...)


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

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

Input: (rem-bops nil nil)

Output: (defmacro REM-BOPS ...)

(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn (save-binfix) (mapc 'rmbop '(nil nil)) (assign-properties)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(%destructure-defhook-args args (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))))

Write a macro that addresses: Macro call that should be transformed by %destructure-defhook-args

Input: (%destructure-defhook-args args (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 %destructure-defhook-args (args &body body)
  (let ((args-sym (gensym)))
    `(let* ((,args-sym ,args)
            (qualifier
            (cond ((and (symbolp (car ,args-sym)) (not (null (car ,args-sym))))
                   (prog1 (car ,args-sym) (setf ,args-sym (cdr ,args-sym))))
                  (t :use-default))))
       (destructuring-bind (specialized-lambda-list &body body) ,args-sym
         ,@body))))

(let* ((#:g123 args) (qualifier (cond ((and (symbolp (car #:g123)) (not (null (car #:g123)))) (prog1 (car #:g123) (setf #:g123 (cdr #:g123)))) (t :use-default)))) (destructuring-bind (specialized-lambda-list &body body) #:g123 (with-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:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form 'go))

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

Input: (defun-compile-time walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form 'go))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form (quote go))) (eval-when (:compile-toplevel) (compile (quote walk-go))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(draw scene (:image :x 10 :y 10 :height 600 :width 600 :xlink-href img-url))

Problem: Macro call that should be transformed by draw

Input: (draw scene (:image :x 10 :y 10 :height 600 :width 600 :xlink-href img-url))

Output:
(defmacro draw (scene (shape &rest params) &rest opts)
  (let ((element (gensym)))
    `(let ((,element (funcall #'make-svg-element ,shape (append (list ,@params) (list ,@opts)))))
       (add-element ,scene ,element)
       ,element)))

(let ((#:g155 (funcall (function make-svg-element) :image (append (list :x 10 :y 10 :height 600 :width 600 :xlink-href img-url) (list))))) (add-element scene #:g155) #:g155)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(mvlet* ((low high (sort-values #'< start stop)) (in-order? (eql low start)) (element-type (if in-order? `(integer ,low (,high)) `(integer (,low) ,high))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type))

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

Input: (mvlet* ((low high (sort-values #'< start stop)) (in-order? (eql low start)) (element-type (if in-order? `(integer ,low (,high)) `(integer (,low) ,high))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type))

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

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

    (var var*... expr)

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

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

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

(multiple-value-bind (low high) (sort-values (function <) start stop) (mvlet* ((in-order? (eql low start)) (element-type (if in-order? (sb-int:quasiquote (integer #S(sb-impl::comma :expr low :kind 0) (#S(sb-impl::comma :expr high :kind 0)))) (sb-int:quasiquote (integer (#S(sb-impl::comma :expr low :kind 0)) #S(sb-impl::comma :expr high :kind 0))))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(c? (if (value bypass-lookup?) 'no-lookup (bwhen-c-stored (v :bar store 'nothing) (value v))))

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

Input: (c? (if (value bypass-lookup?) 'no-lookup (bwhen-c-stored (v :bar store 'nothing) (value v))))

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

(make-c-dependent :code (quote ((if (value bypass-lookup?) (quote no-lookup) (bwhen-c-stored (v :bar store (quote nothing)) (value v))))) :value-state :unevaluated :rule (c-lambda (if (value bypass-lookup?) (quote no-lookup) (bwhen-c-stored (v :bar store (quote nothing)) (value v)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defgenerator repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (if n (dotimes (i n) (yield item)) (loop do (yield item))))

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

Input: (defgenerator repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (if n (dotimes (i n) (yield item)) (loop do (yield item))))

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

(defun repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (with-yield (if n (dotimes (i n) (yield item)) (loop do (yield item)))))


Instruction:
Generate a defmacro form that transforms code like this:
;; Common pattern: test a value, use result in then-branch
(let ((result (compute-something)))
  (if result
      (format t "Got: ~a~%" result)
      :nothing))

;; Want: implicit 'it' bound to test result

Pattern to recognize: Repeated pattern of binding test result then branching on it — want implicit 'it' anaphor

Input:
;; Common pattern: test a value, use result in then-branch
(let ((result (compute-something)))
  (if result
      (format t "Got: ~a~%" result)
      :nothing))

;; Want: implicit 'it' bound to test result

Output:
(defmacro aif (test then &optional else)
  `(let ((it ,test))
     (if it ,then ,else)))

;; (aif (compute-something)
;;      (format t "Got: ~a~%" it)
;;      :nothing)
;; Expands to:
;; (LET ((IT (COMPUTE-SOMETHING)))
;;   (IF IT
;;       (FORMAT T "Got: ~a~%" IT)
;;       :NOTHING))


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

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

Input:
(dynamic-let nil
  (progn))

Output: (defmacro DYNAMIC-LET ...)

(let ()
  (dynamic-wind
    :proceed
    #:g194
    (let ()
      (declare (special))
      (#:g194 (progn)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-easy-macro nil
    (progn))

Issue: Macro call that should be transformed by DEF-EASY-MACRO

Input:
(def-easy-macro nil
    (progn))

Output: (defmacro DEF-EASY-MACRO ...)

(progn
 (defun call-nil (#:|fn127| progn)
   (flet ((#:|fn127| (&rest args) (declare (inline)) (apply #:|fn127| args)))))
 (defmacro nil ((&rest fn-arg-values) &body macro-body)
   nil
   (build-funcall 'call-nil '(progn) fn-arg-values macro-body)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-definition-resolver class designator-class-p)

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

Input: (define-simple-definition-resolver class designator-class-p)

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 class (class #:package137) (when (ignore-errors (designator-class-p class)) (list (make-instance (quote class) :designator class :package #:package137))))


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

Issue: Macro call that should be transformed by DEFPATTERN

Input:
(defpattern nil
    :key
  nil)

Output: (defmacro DEFPATTERN ...)

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


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

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

Input: (define-ps-symbol-macro nil nil)

Output: (defmacro DEFINE-PS-SYMBOL-MACRO ...)

(progn
 nil
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf (gethash 'nil *symbol-macro-toplevel*)
           (lambda (form) (declare (ignore form)) 'nil))))


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

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

Input: (define-modf-rewrite cddaar (expr) `(cdr (cdaar ,(second expr))))

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

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


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

Problem: Macro call that should be transformed by LAMBDA+

Input: (lambda+ nil)

Output: (defmacro LAMBDA+ ...)


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

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

Input: (reduced-typecase nil nil)

Output: (defmacro REDUCED-TYPECASE ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-special-initargs nil
  nil)

Pattern to recognize: Macro call that should be transformed by WITH-SPECIAL-INITARGS

Input:
(with-special-initargs nil
  nil)

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

(funcall-with-special-initargs (list) (lambda () nil))


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

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

Input: (list-of nil)

Output: (defmacro LIST-OF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-yield-binds (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s))))

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

Input: (with-yield-binds (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s))))

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 (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s)))) (loop for bind in (reverse *bind-values*) append bind)))


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

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

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

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


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

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

Input: (defmethod* nil nil)

Output: (defmacro DEFMETHOD* ...)

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


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

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

Input:
(letrec nil
  :key
  nil)

Output: (defmacro LETREC ...)

(let ()
  (flet ()
    nil
    (setf)
    :key
    nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "42P06" duplicate-schema syntax-error-or-access-violation)

Issue: Macro call that should be transformed by deferror

Input: (deferror "42P06" duplicate-schema syntax-error-or-access-violation)

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

(progn (define-condition duplicate-schema (syntax-error-or-access-violation) nil) (setf (gethash "42P06" *error-table*) (quote duplicate-schema)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name)) (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

Issue: Macro call that should be transformed by with-prepared-query

Input: (with-prepared-query query (conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name)) (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

Output:
(defmacro with-prepared-query (query (conn sql &key use-prepare-cached) &body body)
  `(call-with-prepared-query ,conn ,sql (lambda (,query) ,@body) :use-prepare-cached ,use-prepare-cached))

(call-with-prepared-query conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name) (lambda (query) (or (first (dbi.driver:fetch (dbi.driver:execute query) :format :values)) 0)) :use-prepare-cached nil)


Instruction:
Generate a defmacro form that transforms code like this:
(define-modf-function nth 2 (new-val nth obj) (replace-nth nth obj new-val))

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

Input: (define-modf-function nth 2 (new-val nth obj) (replace-nth nth obj new-val))

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

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote nth) *modf-nth-arg*) 2)) (defun |BUILDER:COMMON-LISP:NTH| (new-val nth obj) (replace-nth nth obj new-val)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (eql (top-info) 'aref) (format stream ")"))

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

Input: (when (eql (top-info) 'aref) (format stream ")"))

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

(if (eql (top-info) (quote aref)) (format stream ")"))


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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-declaration nil
    (progn))

What needs to change: Macro call that should be transformed by DEFINE-DECLARATION

Input:
(define-declaration nil
    (progn))

Output: (defmacro DEFINE-DECLARATION ...)

(sb-cltl2:define-declaration nil
    (progn))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name))))

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

Input: (defun-compile-time get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name)))) (eval-when (:compile-toplevel) (compile (quote get-function-record))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
;; Macro with double-evaluation bug
(defmacro square (x)
  `(* ,x ,x))
;; (square (incf y)) evaluates (incf y) TWICE

;; Manual fix requires gensym + let boilerplate every time
(defmacro square (x)
  (let ((g (gensym)))
    `(let ((,g ,x))
       (* ,g ,g))))

Problem: Macro arguments evaluated multiple times (double evaluation) — need automatic once-only that also provides both original form and evaluated value

Input:
;; Macro with double-evaluation bug
(defmacro square (x)
  `(* ,x ,x))
;; (square (incf y)) evaluates (incf y) TWICE

;; Manual fix requires gensym + let boilerplate every time
(defmacro square (x)
  (let ((g (gensym)))
    `(let ((,g ,x))
       (* ,g ,g))))

Output:
(defun o!-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 2)
       (string= (symbol-name s)
                "O!"
                :start1 0
                :end1 2)))

(defun o!-symbol-to-g!-symbol (s)
  (symb "G!"
        (subseq (symbol-name s) 2)))

(defmacro defmacro! (name args &rest body)
  (let* ((os (remove-if-not #'o!-symbol-p (flatten args)))
         (gs (mapcar #'o!-symbol-to-g!-symbol os)))
    (multiple-value-bind (body declarations docstring)
        (parse-body body :documentation t)
      `(defmacro/g! ,name ,args
         ,@(when docstring
            (list docstring))
         ,@declarations
         `(let ,(mapcar #'list (list ,@gs) (list ,@os))
            ,(progn ,@body))))))

;; (defmacro! square (o!x)
;;   `(* ,g!x ,g!x))
;;
;; (macroexpand '(square (incf y)))
;; => (LET ((#:X1633 (INCF Y)))
;;      (* #:X1633 #:X1633))
;;
;; o!x = original form (still accessible via ',o!x)
;; g!x = evaluated value, bound once


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

Issue: Macro call that should be transformed by DEFGENERIC*

Input: (defgeneric* nil (progn))

Output: (defmacro DEFGENERIC* ...)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(make-obsolete mustache-context make-context "0.10.0")

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

Input: (make-obsolete mustache-context make-context "0.10.0")

Output:
(defmacro make-obsolete (obsolete-name current-name when)
  `(defun ,obsolete-name (&rest args)
     ,(documentation current-name 'function)
     (warn 'deprecation-warning
           :name ',obsolete-name :replacement ',current-name :since ,when)
     (apply ',current-name args)))

(defun mustache-context (&rest args) #A((40) base-char . "Create mustache context from alist DATA.") (warn (quote deprecation-warning) :name (quote mustache-context) :replacement (quote make-context) :since "0.10.0") (apply (quote make-context) args))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do-generator (a b (with-yield (dolist (x data) (yield x (1+ x))))) a (return b))

What needs to change: Macro call that should be transformed by do-generator

Input: (do-generator (a b (with-yield (dolist (x data) (yield x (1+ x))))) a (return b))

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

(let ((#:g171 (with-yield (dolist (x data) (yield x (1+ x)))))) (loop do (if-generator ((a b) #:g171) (progn a (return b)) (return))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-c-syntax-reader-for-each-case-mode c-reader-level-0)

What needs to change: Macro call that should be transformed by define-c-syntax-reader-for-each-case-mode

Input: (define-c-syntax-reader-for-each-case-mode c-reader-level-0)

Output:
(defmacro define-c-syntax-reader-for-each-case-mode (base-readtable-name)
  (check-type base-readtable-name symbol)
  (loop with case-modes = '(:upcase :downcase :preserve :invert)
        for mode in case-modes
        as name = (format-symbol :with-c-syntax.core "~A-~A" base-readtable-name mode)
        collect `(defreadtable ,name
                   (:merge ,base-readtable-name)
                   (:case ,mode))
          into bodies
        finally
           (return `(progn ,@bodies))))

(progn (defreadtable c-reader-level-0-upcase (:merge c-reader-level-0) (:case :upcase)) (defreadtable c-reader-level-0-downcase (:merge c-reader-level-0) (:case :downcase)) (defreadtable c-reader-level-0-preserve (:merge c-reader-level-0) (:case :preserve)) (defreadtable c-reader-level-0-invert (:merge c-reader-level-0) (:case :invert)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-html-string (:ul (:li (:a "hai"))))

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

Input: (with-html-string (:ul (:li (:a "hai"))))

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 (:ul (:li (:a "hai")))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(aand (values nil t) it)

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

Input: (aand (values nil t) it)

Output:
(defmacro aand (first &rest rest)
  "Like AND, except binds the first argument to IT (via LET) for the
scope of the rest of the arguments."
  `(anaphoric and ,first ,@rest))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-open-temporary-file (f :keep t) (pathname f))

Problem: Macro call that should be transformed by with-open-temporary-file

Input: (with-open-temporary-file (f :keep t) (pathname f))

Output:
(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body)
  "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
  with STREAM bound to the temporary file stream.  Returns the values
  returned by BODY.  By default, the file is deleted when BODY is
  exited. If a true value is passed in KEEP, the file is not deleted
  when the body is exited.  See OPEN-TEMPORARY for more permitted
  options."
  `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep)))
     #+sbcl
     (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
     ,(if (and (constantp keep)
               keep)
          `(progn ,@body)
          `(unwind-protect
                (progn ,@body)
             (unless ,keep
               (close ,stream)
               (delete-file (pathname ,stream)))))))

(with-open-stream (f (open-temporary)) (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) (progn (pathname f)))


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

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

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defun-compile-time expand-local-setq (pairs environment) (if (null pairs) '(progn) (let ((d (gensym "DUMMY-"))) `(let ((,d ,(first pairs))) (trail #'(lambda () (setq ,(first pairs) ,d))) ,@(if (null (rest (rest pairs))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment)) (expand-local-setq (rest (rest pairs)) environment)))))))

Write a macro that addresses: Macro call that should be transformed by defun-compile-time

Input: (defun-compile-time expand-local-setq (pairs environment) (if (null pairs) '(progn) (let ((d (gensym "DUMMY-"))) `(let ((,d ,(first pairs))) (trail #'(lambda () (setq ,(first pairs) ,d))) ,@(if (null (rest (rest pairs))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment)) (expand-local-setq (rest (rest pairs)) environment)))))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun expand-local-setq (pairs environment) (if (null pairs) (quote (progn)) (let ((d (gensym "DUMMY-"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr d :kind 0) #S(sb-impl::comma :expr (first pairs) :kind 0))) (trail (function (lambda nil (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr d :kind 0))))) #S(sb-impl::comma :expr (if (null (rest (rest pairs))) (list (sb-int:quasiquote (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr (perform-substitutions (second pairs) environment) :kind 0)))) (list (sb-int:quasiquote (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr (perform-substitutions (second pairs) environment) :kind 0))) (expand-local-setq (rest (rest pairs)) environment))) :kind 2)))))) (eval-when (:compile-toplevel) (compile (quote expand-local-setq))))


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

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

Input: (lambda () nil)

Output: (defmacro LAMBDA ...)


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

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

Input:
(resolving
  nil
  (progn))

Output: (defmacro RESOLVING ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-decoder-simple-clos-semantics (is (equal-objects-p (make-instance 'frob :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class 'foo)) (finalize-inheritance (find-class 'goo)) (is (equal-objects-p (json:make-object '((bar . 46) (xyzzy . t) (quux . 98)) nil '(foo goo)) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) 'prototype)) (is (equalp '((bar . 46) (xyzzy . t) (quux . 98)) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))

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

Input: (with-decoder-simple-clos-semantics (is (equal-objects-p (make-instance 'frob :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class 'foo)) (finalize-inheritance (find-class 'goo)) (is (equal-objects-p (json:make-object '((bar . 46) (xyzzy . t) (quux . 98)) nil '(foo goo)) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) 'prototype)) (is (equalp '((bar . 46) (xyzzy . t) (quux . 98)) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))

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

(with-shadowed-custom-vars (set-decoder-simple-clos-semantics) (is (equal-objects-p (make-instance (quote frob) :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class (quote foo))) (finalize-inheritance (find-class (quote goo))) (is (equal-objects-p (make-object (quote ((bar . 46) (xyzzy . t) (quux . 98))) nil (quote (foo goo))) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) (quote prototype))) (is (equalp (quote ((bar . 46) (xyzzy . t) (quux . 98))) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(action (:after node-lisp node bound-variables) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq)))) (setf unsafe? t)) (values))

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

Input: (action (:after node-lisp node bound-variables) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq)))) (setf unsafe? t)) (values))

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

(make-action (quote :after) (quote node-lisp) (lambda (node bound-variables) (declare (type node-lisp node)) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test (function eq))))) (setf unsafe? t)) (values)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (find (first x) (list 'flag)) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))

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

Input: (when (find (first x) (list 'flag)) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))

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

(if (find (first x) (list (quote flag))) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is (< less more))

Problem: Macro call that should be transformed by is

Input: (is (< less more))

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 ((#:e247 less) (#:a248 more)) (if (progn (< #:e247 #:a248)) (add-result (quote test-passed) :test-expr (quote (< less more))) (process-failure (quote (< less more)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote more) #:a248 (quote <) #:e247)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "57014" query-canceled operator-intervention)

Issue: Macro call that should be transformed by deferror

Input: (deferror "57014" query-canceled operator-intervention)

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

(progn (define-condition query-canceled (operator-intervention) nil) (setf (gethash "57014" *error-table*) (quote query-canceled)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
;; Manual dispatch by keyword with multiple lambdas is repetitive
(let ((count 0))
  (setf (symbol-function 'counter)
        (lambda (&rest args)
          (case (car args)
            (:inc (apply (lambda (n) (incf count n)) (cdr args)))
            (:dec (apply (lambda (n) (decf count n)) (cdr args)))
            (:reset (progn (setf count 0) nil))
            (t (error "Unknown: ~a" (car args)))))))

;; Every method: keyword, lambda wrapper, arg destructuring - repetitive

Write a macro that addresses: Repeated keyword-dispatch with automatic argument destructuring — each keyword maps to a lambda with its own parameter list

Input:
;; Manual dispatch by keyword with multiple lambdas is repetitive
(let ((count 0))
  (setf (symbol-function 'counter)
        (lambda (&rest args)
          (case (car args)
            (:inc (apply (lambda (n) (incf count n)) (cdr args)))
            (:dec (apply (lambda (n) (decf count n)) (cdr args)))
            (:reset (progn (setf count 0) nil))
            (t (error "Unknown: ~a" (car args)))))))

;; Every method: keyword, lambda wrapper, arg destructuring - repetitive

Output:
(defmacro! dlambda (&rest ds)
  `(lambda (&rest ,g!args)
     (case (car ,g!args)
       ,@(mapcar
           (lambda (d)
             `(,(if (eq t (car d))
                  t
                  (list (car d)))
               (apply (lambda ,@(cdr d))
                      ,(if (eq t (car d))
                         g!args
                         `(cdr ,g!args)))))
           ds))))

;; (dlambda
;;   (:inc (n) (incf count n))
;;   (:dec (n) (decf count n))
;;   (:reset () (setf count 0))
;;   (t (&rest args) (format t "Unknown: ~a~%" args)))
;;
;; Expands to a single lambda with case dispatch.
;; Each method has its own destructured argument list.
;; t as the key provides a default/catch-all.


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

Problem: Macro call that should be transformed by DEF-DYNENV-VAR

Input: (def-dynenv-var nil (progn))

Output: (defmacro DEF-DYNENV-VAR ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar #:nil173 (load-time-value (progn)))
  (setf (get 'nil 'dynenv-var) '#:nil173)
  (define-symbol-macro nil (get-dynenv-var 'nil)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(-> :g ((a (n) b c (d e f))) (put (list a n b c d e f)))

Issue: Macro call that should be transformed by ->

Input: (-> :g ((a (n) b c (d e f))) (put (list a n b c d e f)))

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

(atomically :g ((a (n) b c (d e f))) (put (list a n b c d e f)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(deftag dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string 'dynamic-tag-thunk))) (attrs (escape-attrs nil attrs))) `(prog1 nil (flet ((,thunk () ,@(loop for expr in body collect `(catch-output ,expr)))) (declare (dynamic-extent #',thunk)) (dynamic-tag* ,name (list ,@attrs) #',thunk ,empty?)))))

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

Input: (deftag dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string 'dynamic-tag-thunk))) (attrs (escape-attrs nil attrs))) `(prog1 nil (flet ((,thunk () ,@(loop for expr in body collect `(catch-output ,expr)))) (declare (dynamic-extent #',thunk)) (dynamic-tag* ,name (list ,@attrs) #',thunk ,empty?)))))

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 dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string (quote dynamic-tag-thunk)))) (attrs (escape-attrs nil attrs))) (sb-int:quasiquote (prog1 nil (flet ((#S(sb-impl::comma :expr thunk :kind 0) nil #S(sb-impl::comma :expr (loop for expr in body collect (sb-int:quasiquote (catch-output #S(sb-impl::comma :expr expr :kind 0)))) :kind 2))) (declare (dynamic-extent (function #S(sb-impl::comma :expr thunk :kind 0)))) (dynamic-tag* #S(sb-impl::comma :expr name :kind 0) (list #S(sb-impl::comma :expr attrs :kind 2)) (function #S(sb-impl::comma :expr thunk :kind 0)) #S(sb-impl::comma :expr empty? :kind 0)))))))


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

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

Input:
(some->
  nil
  (progn))

Output: (defmacro SOME-> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(c-assert (listp old-kids))

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

Input: (c-assert (listp old-kids))

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

(unless *stop* (unless (listp old-kids) (c-break "failed assertion: ~a" (quote (listp old-kids)))))


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

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

Input: (continue-whopper)

Output: (defmacro CONTINUE-WHOPPER ...)

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


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

Problem: Macro call that should be transformed by REDUCED-TYPECASE

Input: (reduced-typecase nil)

Output: (defmacro REDUCED-TYPECASE ...)


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

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

Input: (defsynonym there-is :there-is)

Output:
(defmacro defsynonym (symbol synonym)
  "Set SYNONYM for a SYMBOL. "
  `(eval-always
     (setf (get ',symbol 'synonym) ',synonym)))

(eval-always (setf (get (quote there-is) (quote synonym)) (quote :there-is)))


Instruction:
Generate a defmacro form that transforms code like this:
(do+ inner-loop (do+ (terminate outer-loop 3)))

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

Input: (do+ inner-loop (do+ (terminate outer-loop 3)))

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

(do+/internal nil inner-loop (do+ (terminate outer-loop 3)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(iterate:declare-variables)

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

Input: (iterate:declare-variables)

Output:
(defmacro iter (&body body &environment env)
  "Jonathan Amsterdam's powerful and extensible iteration facility,
providing multiple accumulation, generators, memory of previous
iterations, over 50 clauses to start with and a Lisp-like syntax.
Evaluate (iterate:display-iterate-clauses) for an overview of clauses"
  (let* ((*env* env)
	 (*result-var* (genvar 'result))
	 (*type-alist* nil)
	 (*declare-variables* *always-declare-variables*)
	 (*bindings* nil)
	 (*internal-variables* nil)
	 (*previous-vars-alist* nil)
	 (*declarations* nil)
	 (*loop-body-wrappers* nil)
	 (*accum-var-alist* nil)
	 (*shared-bindings-alist* nil)
	 (*top-level?* t)
	 (*binding-context?* nil)
	 (*temps* nil)
	 (*temps-in-use* nil)
	 (*driver-info-alist* nil)
	 (*loop-name* (if (symbolp (car body))
			  (car body)
			  (gensym "ITERATE")))
	 (*block-name* (if (symbolp (car body))
			   (pop body)
			   nil))
	 (*loop-top* (symbol-append 'loop-top- *block-name*))
	 (*loop-step* (symbol-append 'loop-step- *block-name*))
	 (*loop-end* (symbol-append 'loop-end- *block-name*))
	 (*loop-step-used?* nil)
	 (*loop-end-used?* nil))
    (process-top-level-decls body)
    (multiple-value-bind (body decls init-code steppers final-code final-prot)
	(walk-list body)
      (multiple-value-bind (init step)
	  (insert-previous-code)
	(augment init-code init)
	(augment steppers step))
      (prepend (default-driver-code) body)
      (let* ((it-bod `(block ,*loop-name*
			(tagbody
			  (progn ,.init-code)
			  ,*loop-top*
			  (progn ,.body)
			  ,.(if *loop-step-used?* (list *loop-step*))
			  (progn ,.steppers)
			  (go ,*loop-top*)
			  ,.(if *loop-end-used?* (list *loop-end*))
			  (progn ,.final-code))
			,(if (member *result-var* *bindings* :key #'car)
			   *result-var*
			   nil)))
	     (it-bod (if (eql *block-name* nil)
			 `(block nil ,it-bod)
			 it-bod)))
	(wrap-form *loop-body-wrappers*
		   `(let* ,(nreverse *bindings*)
		     ,.(if *declarations*
			   `((declare .,*declarations*)))
		     ,.decls
		     ,(if final-prot
			  `(unwind-protect ,it-bod .,final-prot)
			  it-bod)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(bind ((#(a nil c) #(1 2 3))) (list a c))

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

Input: (bind ((#(a nil c) #(1 2 3))) (list a c))

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

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

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

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

(let* ((#:|values-168| #(1 2 3)) (a (aref #:|values-168| 0)) (c (aref #:|values-168| 2))) (declare (ignorable #:|values-168|)) (progn (list a c)))


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

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

Input: (defsynonym finish :finish)

Output:
(defmacro defsynonym (symbol synonym)
  "Set SYNONYM for a SYMBOL. "
  `(eval-always
     (setf (get ',symbol 'synonym) ',synonym)))

(eval-always (setf (get (quote finish) (quote synonym)) (quote :finish)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error multi-val-bind-mismatch () (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map 'list #'type->type-spec return-set))

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

Input: (define-error multi-val-bind-mismatch () (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map 'list #'type->type-spec return-set))

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

(defcondition multi-val-bind-mismatch (:error-type varjo-error :prefix "Varjo") (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map (quote list) (function type->type-spec) return-set))


Instruction:
Generate a defmacro form that transforms code like this:
(with-open-temporary-file (f :keep nil))

Pattern to recognize: Macro call that should be transformed by with-open-temporary-file

Input: (with-open-temporary-file (f :keep nil))

Output:
(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body)
  "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
  with STREAM bound to the temporary file stream.  Returns the values
  returned by BODY.  By default, the file is deleted when BODY is
  exited. If a true value is passed in KEEP, the file is not deleted
  when the body is exited.  See OPEN-TEMPORARY for more permitted
  options."
  `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep)))
     #+sbcl
     (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
     ,(if (and (constantp keep)
               keep)
          `(progn ,@body)
          `(unwind-protect
                (progn ,@body)
             (unless ,keep
               (close ,stream)
               (delete-file (pathname ,stream)))))))

(with-open-stream (f (open-temporary)) (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) (unwind-protect (progn) (unless nil (close f) (delete-file (pathname f)))))


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

What needs to change: Macro call that should be transformed by DYNAMIC-RELET*

Input:
(dynamic-relet* nil
  :key
  nil)

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


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

Issue: Macro call that should be transformed by WITH-SYMBOL-ACCESS

Input:
(with-symbol-access
  nil
  :key
  nil)

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

(let ((*symbol-access* t))
  nil
  :key
  nil)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun/1 log10 (x) (log x 10))

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

Input: (defun/1 log10 (x) (log x 10))

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 log10 (x) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (log x 10)) (defparameter log10 (vacietis.c:mkptr& (symbol-function (quote log10)))))


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

Pattern to recognize: 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:
(define-cruft %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." #+ :sbcl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (sb-impl::dispatch-tables readtable) nil)) #+ :allegro (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (let ((dispatch-tables (excl::readtable-dispatch-tables readtable))) (setf (cdr dispatch-tables) nil) (setf (caar dispatch-tables) #\Backspace) (setf (cadar dispatch-tables) (fill (cadar dispatch-tables) nil)))) #+ :cmucl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (lisp::dispatch-tables readtable) nil)) #+ :common-lisp (do-readtable (char readtable readtable) (set-syntax-from-char char #\A readtable)))

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

Input: (define-cruft %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." #+ :sbcl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (sb-impl::dispatch-tables readtable) nil)) #+ :allegro (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (let ((dispatch-tables (excl::readtable-dispatch-tables readtable))) (setf (cdr dispatch-tables) nil) (setf (caar dispatch-tables) #\Backspace) (setf (cadar dispatch-tables) (fill (cadar dispatch-tables) nil)))) #+ :cmucl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (lisp::dispatch-tables readtable) nil)) #+ :common-lisp (do-readtable (char readtable readtable) (set-syntax-from-char char #\A readtable)))

Output:
(defmacro define-cruft (name lambda-list &body (docstring . alternatives))
  (assert (typep docstring 'string) (docstring) "Docstring missing!")
  (assert (not (null alternatives)))
  `(progn
     (declaim (inline ,name))
     (defun ,name ,lambda-list ,docstring ,(first alternatives))))

(progn (declaim (inline %clear-readtable)) (defun %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\LATIN_CAPITAL_LETTER_A readtable)) (setf (sb-impl:dispatch-tables readtable) nil))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-package (package) (loop for (type . args) in options do (expand-option type package args)))

Issue: Macro call that should be transformed by with-package

Input: (with-package (package) (loop for (type . args) in options do (expand-option type package args)))

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

(let ((package (ensure-package package))) (loop for (type . args) in options do (expand-option type package args)))


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

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

Input: (defsynonym count :count)

Output:
(defmacro defsynonym (symbol synonym)
  "Set SYNONYM for a SYMBOL. "
  `(eval-always
     (setf (get ',symbol 'synonym) ',synonym)))

(eval-always (setf (get (quote count) (quote synonym)) (quote :count)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (format nil "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement))))

Issue: Macro call that should be transformed by with-yield-binds

Input: (with-yield-binds (format nil "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement))))

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 "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement)))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(*> +opt-fws+ #'comment)

Problem: Macro call that should be transformed by *>

Input: (*> +opt-fws+ #'comment)

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

(lambda (#:*>-offset137) (multiple-value-bind (#:*>-res138 #:*>-next139) (funcall +opt-fws+ #:*>-offset137) (if (ok? #:*>-res138) (funcall (function comment) #:*>-next139) (fail #:*>-next139))))


Instruction:
Generate a defmacro form that transforms code like this:
(compiler-macro-lambda (int) `(format t "~&Compile time: ~A -> ~A.~%" ',int ,int))

Pattern to recognize: Macro call that should be transformed by compiler-macro-lambda

Input: (compiler-macro-lambda (int) `(format t "~&Compile time: ~A -> ~A.~%" ',int ,int))

Output:
(defmacro compiler-macro-lambda (lambda-list &body body)
  (introspect-environment:parse-compiler-macro (gensym "COMPILER-MACRO-LAMBDA")
                                               lambda-list
                                               body))

(sb-int:named-lambda (compiler-macro #:compiler-macro-lambda145) (#:expr #:env) (declare (sb-c::lambda-list (int))) (declare (ignore #:env)) (sb-int:named-ds-bind (:macro #:compiler-macro-lambda145 . define-compiler-macro) (int) (sb-c::compiler-macro-args #:expr) (declare (sb-c::constant-value int) (sb-c::no-compiler-macro #:compiler-macro-lambda145)) (block #:compiler-macro-lambda145 (sb-int:quasiquote (format t "~&Compile time: ~A -> ~A.~%" (quote #S(sb-impl::comma :expr int :kind 0)) #S(sb-impl::comma :expr int :kind 0))))))


Instruction:
Generate a defmacro form that transforms code like this:
(in-compile-time nil
  :key
  nil)

Pattern to recognize: Macro call that should be transformed by IN-COMPILE-TIME

Input:
(in-compile-time nil
  :key
  nil)

Output: (defmacro IN-COMPILE-TIME ...)

(macrolet ((#:macro144 (&environment ())
             :key
             nil))
  (#:macro144))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-yield-binds (format nil "~A AS ~A" (if (sql-statement-p (as-op-left op)) (yield (make-sql-list (as-op-left op))) (yield (as-op-left op))) (with-table-name nil (yield (as-op-right op)))))

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

Input: (with-yield-binds (format nil "~A AS ~A" (if (sql-statement-p (as-op-left op)) (yield (make-sql-list (as-op-left op))) (yield (as-op-left op))) (with-table-name nil (yield (as-op-right op)))))

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 AS ~A" (if (sql-statement-p (as-op-left op)) (yield (make-sql-list (as-op-left op))) (yield (as-op-left op))) (with-table-name nil (yield (as-op-right op))))) (loop for bind in (reverse *bind-values*) append bind)))


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

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

Input: (vect-of nil nil)

Output: (defmacro VECT-OF ...)

(let ((#:vect138 (make-array 10 :adjustable t :fill-pointer 0)))
  (do-for (nil)
    (vector-push-extend nil #:vect138))
  #:vect138)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-iter iterator-repeat (max curr item) (repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0))) (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))

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

Input: (def-iter iterator-repeat (max curr item) (repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0))) (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname133 (&key max curr item) (labels ((self nil (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))) (function self)))) (defun repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname133)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0)))))


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

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

Input: (setf nil (progn))

Output: (defmacro SETF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-global-parameter nil (progn))

Pattern to recognize: Macro call that should be transformed by DEFINE-GLOBAL-PARAMETER

Input: (define-global-parameter nil (progn))

Output: (defmacro DEFINE-GLOBAL-PARAMETER ...)

(progn
 (store-in-symbol-plist nil (progn) .value-key.)
 (sb-ext:defglobal nil (get 'nil +value-key+))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf nil (get 'nil +value-key+)))
 (remprop 'nil +value-key+)
 'nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-definition-resolver optimizer (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes '(sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance 'optimizer :designator designator :package package :optimizer fn))))))

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

Input: (define-definition-resolver optimizer (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes '(sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance 'optimizer :designator designator :package package :optimizer fn))))))

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

(progn (setf (definition-resolver (quote optimizer)) (lambda (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes (quote (sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver)))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance (quote optimizer) :designator designator :package package :optimizer fn))))))) (quote optimizer))


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

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

Input:
(->
  nil
  :key
  nil)

Output: (defmacro -> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-mocks () (register-mock 'foo) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations)))))

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

Input: (with-mocks () (register-mock 'foo) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations)))))

Output:
(defmacro with-mocks ((&key (recordp T)) &body body)
  "Execute BODY in a new mocking context.  Invocations will be recorded
if RECORDP is set (default true)."
  `(call-with-mocks
    (lambda () ,@body)
    :recordp ,recordp))

(call-with-mocks (lambda nil (register-mock (quote foo)) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations))))) :recordp t)


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

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

Input: (with-env (setp 7 [struct 'a]))

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

(let (#:g139) (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 #:g139 (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 7 [struct (quote a])))) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g139)


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

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

Input: (define-element-maker :symbol "symbol" '(:id))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(*> #'any #'eof)

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

Input: (*> #'any #'eof)

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

(lambda (#:*>-offset161) (multiple-value-bind (#:*>-res162 #:*>-next163) (funcall (function any) #:*>-offset161) (if (ok? #:*>-res162) (funcall (function eof) #:*>-next163) (fail #:*>-next163))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when head (if (eql (first head) t) (cons 'progn (cdr head)) `(if ,(first head) ,(when (cdr head) (cons 'progn (cdr head))) ,(when (cdr clauses) `(cond ,@(cdr clauses))))))

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

Input: (when head (if (eql (first head) t) (cons 'progn (cdr head)) `(if ,(first head) ,(when (cdr head) (cons 'progn (cdr head))) ,(when (cdr clauses) `(cond ,@(cdr clauses))))))

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

(if head (if (eql (first head) t) (cons (quote progn) (cdr head)) (sb-int:quasiquote (if #S(sb-impl::comma :expr (first head) :kind 0) #S(sb-impl::comma :expr (when (cdr head) (cons (quote progn) (cdr head))) :kind 0) #S(sb-impl::comma :expr (when (cdr clauses) (sb-int:quasiquote (cond #S(sb-impl::comma :expr (cdr clauses) :kind 2)))) :kind 0)))))


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

Issue: Macro call that should be transformed by DEFITER

Input:
(defiter nil
    nil)

Output: (defmacro DEFITER ...)

(defun nil () (make-instance 'iterator :coro (lambda-coro)))