Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-all-tags)

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

Input: (define-all-tags)

Output:
(defmacro define-all-tags ()
  `(progn
     ,@(loop for tag in (hash-table-keys *html5-elements*)
             collect `(define-tag ,tag))))

(progn (define-tag :vkern) (define-tag :view) (define-tag :use) (define-tag :tspan) (define-tag :tref) (define-tag :textpath) (define-tag :text) (define-tag :symbol) (define-tag :switch) (define-tag :stop) (define-tag :set) (define-tag :rect) (define-tag :radialgradient) (define-tag :polyline) (define-tag :polygon) (define-tag :pattern) (define-tag :path) (define-tag :mpath) (define-tag :missing-glyph) (define-tag :metadata) (define-tag :mask) (define-tag :marker) (define-tag :lineargradient) (define-tag :line) (define-tag :image) (define-tag :hkern) (define-tag :glyphref) (define-tag :glyph) (define-tag :g) (define-tag :foreignobject) (define-tag :font-face-uri) (define-tag :font-face-src) (define-tag :font-face-name) (define-tag :font-face-format) (define-tag :font-face) (define-tag :font) (define-tag :filter) (define-tag :feturbulence) (define-tag :fetile) (define-tag :fespotlight) (define-tag :fespecularlighting) (define-tag :fepointlight) (define-tag :feoffset) (define-tag :femorphology) (define-tag :femergenode) (define-tag :femerge) (define-tag :feimage) (define-tag :fegaussianblur) (define-tag :fefuncr) (define-tag :fefuncg) (define-tag :fefuncb) (define-tag :fefunca) (define-tag :feflood) (define-tag :fedropshadow) (define-tag :fedistantlight) (define-tag :fedisplacementmap) (define-tag :fediffuselighting) (define-tag :feconvolvematrix) (define-tag :fecomposite) (define-tag :fecomponenttransfer) (define-tag :fecolormatrix) (define-tag :feblend) (define-tag :ellipse) (define-tag :desc) (define-tag :defs) (define-tag :cursor) (define-tag :clippath) (define-tag :circle) (define-tag :animatetransform) (define-tag :animatemotion) (define-tag :animate) (define-tag :wbr) (define-tag :video) (define-tag :var) (define-tag :ul) (define-tag :u) (define-tag :track) (define-tag :tr) (define-tag :title) (define-tag :time) (define-tag :thead) (define-tag :th) (define-tag :tfoot) (define-tag :textarea) (define-tag :template) (define-tag :td) (define-tag :tbody) (define-tag :table) (define-tag :sup) (define-tag :summary) (define-tag :svg) (define-tag :sub) (define-tag :style) (define-tag :strong) (define-tag :span) (define-tag :source) (define-tag :small) (define-tag :select) (define-tag :section) (define-tag :script) (define-tag :samp) (define-tag :s) (define-tag :ruby) (define-tag :rt) (define-tag :rp) (define-tag :q) (define-tag :progress) (define-tag :pre) (define-tag :picture) (define-tag :param) (define-tag :p) (define-tag :output) (define-tag :option) (define-tag :optgroup) (define-tag :ol) (define-tag :object) (define-tag :noscript) (define-tag :nav) (define-tag :meter) (define-tag :meta) (define-tag :menu) (define-tag :math) (define-tag :mark) (define-tag :map) (define-tag :main) (define-tag :link) (define-tag :li) (define-tag :legend) (define-tag :label) (define-tag :keygen) (define-tag :kbd) (define-tag :ins) (define-tag :input) (define-tag :img) (define-tag :iframe) (define-tag :i) (define-tag :html) (define-tag :hr) (define-tag :hgroup) (define-tag :header) (define-tag :h6) (define-tag :h5) (define-tag :h4) (define-tag :h3) (define-tag :h2) (define-tag :h1) (define-tag :head) (define-tag :form) (define-tag :footer) (define-tag :figure) (define-tag :figcaption) (define-tag :fieldset) (define-tag :embed) (define-tag :em) (define-tag :dt) (define-tag :dl) (define-tag :div) (define-tag :dialog) (define-tag :dfn) (define-tag :details) (define-tag :del) (define-tag :dd) (define-tag :datalist) (define-tag :data) (define-tag :command) (define-tag :colgroup) (define-tag :col) (define-tag :code) (define-tag :cite) (define-tag :caption) (define-tag :canvas) (define-tag :button) (define-tag :br) (define-tag :body) (define-tag :blockquote) (define-tag :bdo) (define-tag :bdi) (define-tag :base) (define-tag :b) (define-tag :audio) (define-tag :aside) (define-tag :article) (define-tag :area) (define-tag :address) (define-tag :abbr) (define-tag :a))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-modf-rewrite cadadr (expr) `(car (cdadr ,(second expr))))

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

Input: (define-modf-rewrite cadadr (expr) `(car (cdadr ,(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 cadadr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (car (cdadr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(draw scene (:rect :x 10 :y 10 :width 3980 :height 1980) :fill "none" :stroke "blue" :stroke-width 10)

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

Input: (draw scene (:rect :x 10 :y 10 :width 3980 :height 1980) :fill "none" :stroke "blue" :stroke-width 10)

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 ((#:g152 (funcall (function make-svg-element) :rect (append (list :x 10 :y 10 :width 3980 :height 1980) (list :fill "none" :stroke "blue" :stroke-width 10))))) (add-element scene #:g152) #:g152)


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

Problem: Macro call that should be transformed by FOR

Input:
(for nil
    nil)

Output: (defmacro FOR ...)

(let ((#:|generator!120| nil))
  (assert (typep #:|generator!120| 'generator!))
  (unwind-protect
      (loop :while (has-next-p #:|generator!120|)
            :do (let ((nil (next #:|generator!120|))))))
  (stop #:|generator!120|))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(actypecase 0 (string it))

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

Input: (actypecase 0 (string it))

Output:
(defmacro actypecase (keyform &body cases)
  "Like CTYPECASE, except binds the result of the keyform to IT (via LET) for
the scope of the cases. Unlike CTYPECASE, new values possible stored by the
STORE-VALUE restart are not received by the keyform/place, but by IT."
  `(anaphoric ctypecase ,keyform ,@cases))


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

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

Input:
(gathering nil
  :key
  nil)

Output: (defmacro GATHERING ...)

(common-lisp:let ()
  :key
  nil
  (values))


Instruction:
Generate a defmacro form that transforms code like this:
(action (:before node-let) #'add-local-funs)

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

Input: (action (:before node-let) #'add-local-funs)

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 :before) (quote node-let) (function add-local-funs))


Instruction:
Generate a defmacro form that transforms code like this:
(define-api ensure-readtable (name &optional (default nil default-p)) (named-readtable-designator &optional (or named-readtable-designator null) => readtable) "Looks up the readtable specified by NAME and returns it if it's found. If it is not found, it registers the readtable designated by DEFAULT under the name represented by NAME; or if no default argument is given, it signals an error of type READTABLE-DOES-NOT-EXIST instead." (cond ((find-readtable name)) ((not default-p) (error 'readtable-does-not-exist :readtable-name name)) (t (setf (find-readtable name) (ensure-readtable default)))))

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

Input: (define-api ensure-readtable (name &optional (default nil default-p)) (named-readtable-designator &optional (or named-readtable-designator null) => readtable) "Looks up the readtable specified by NAME and returns it if it's found. If it is not found, it registers the readtable designated by DEFAULT under the name represented by NAME; or if no default argument is given, it signals an error of type READTABLE-DOES-NOT-EXIST instead." (cond ((find-readtable name)) ((not default-p) (error 'readtable-does-not-exist :readtable-name name)) (t (setf (find-readtable name) (ensure-readtable default)))))

Output:
(defmacro define-api (name lambda-list type-list &body body)
  (flet ((parse-type-list (type-list)
           (let ((pos (position '=> type-list)))
             (assert pos () "You forgot to specify return type (`=>' missing.)")
             (values (subseq type-list 0 pos)
                     `(values ,@(nthcdr (1+ pos) type-list) &optional)))))
    (multiple-value-bind (body decls docstring)
        (parse-body body :documentation t :whole `(define-api ,name))
      (multiple-value-bind (arg-typespec value-typespec)
          (parse-type-list type-list)
        (multiple-value-bind (reqs opts rest keys)
            (parse-ordinary-lambda-list lambda-list)
          (declare (ignorable reqs opts rest keys))
          `(progn
             (declaim (ftype (function ,arg-typespec ,value-typespec) ,name))
             (locally
                 ;; Muffle the annoying "&OPTIONAL and &KEY found in
                 ;; the same lambda list" style-warning
                 #+sbcl (declare (sb-ext:muffle-conditions style-warning))
               (defun ,name ,lambda-list
                 ,docstring
                 ,@decls
                 (locally
                     #+sbcl (declare (sb-ext:unmuffle-conditions style-warning))

                     ;; SBCL will interpret the ftype declaration as
                     ;; assertion and will insert type checks for us.
                     #-sbcl
                     (progn
                       ;; CHECK-TYPE required parameters
                       ,@(loop for req-arg in reqs
                               for req-type = (pop type-list)
                               do (assert req-type)
                               collect `(check-type ,req-arg ,req-type))

                       ;; CHECK-TYPE optional parameters
                       ,@(progn
                           (assert (or (null opts)
                                       (eq (pop type-list) '&optional)))
                           (loop for (opt-arg . nil) in opts
                                 for opt-type = (pop type-list)
                                 do (assert opt-type)
                                 collect `(check-type ,opt-arg ,opt-type)))

                       ;; CHECK-TYPE rest parameter
                       ,@(when rest
                           (assert (eq (pop type-list) '&rest))
                           (let ((rest-type (pop type-list)))
                             (assert rest-type)
                             `((dolist (x ,rest)
                                 (check-type x ,rest-type)))))

                       ;; CHECK-TYPE key parameters
                       ,@(progn
                           (assert (or (null keys)
                                       (eq (pop type-list) '&key)))
                           (loop for ((keyword key-arg)  . nil) in keys
                                 for (nil key-type) = (find keyword type-list
                                                            :key #'car)
                                 collect `(check-type ,key-arg ,key-type))))

                     ,@body)))))))))

(progn (declaim (ftype (function (named-readtable-designator &optional (or named-readtable-designator null)) (values readtable &optional)) ensure-readtable)) (locally (declare (sb-ext:muffle-conditions style-warning)) (defun ensure-readtable (name &optional (default nil default-p)) "Looks up the readtable specified by NAME and returns it if it's found. If it is not found, it registers the readtable designated by DEFAULT under the name represented by NAME; or if no default argument is given, it signals an error of type READTABLE-DOES-NOT-EXIST instead." (locally (declare (sb-ext:unmuffle-conditions style-warning)) (cond ((find-readtable name)) ((not default-p) (error (quote readtable-does-not-exist) :readtable-name name)) (t (setf (find-readtable name) (ensure-readtable default))))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(pop-preprocessor-directive-token tmp-token-list directive-symbol)

Write a macro that addresses: Macro call that should be transformed by pop-preprocessor-directive-token

Input: (pop-preprocessor-directive-token tmp-token-list directive-symbol)

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclause-driver (for var in-file filename &optional using (reader '#'read)) "Forms in a file" (top-level-check) (return-stream-driver-code var filename reader :file generate))

Issue: Macro call that should be transformed by defclause

Input: (defclause-driver (for var in-file filename &optional using (reader '#'read)) "Forms in a file" (top-level-check) (return-stream-driver-code var filename reader :file generate))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-for-in-file-6 (&key ((:for var)) ((:in-file filename)) ((:using reader) (quote (function read))) generate) "Forms in a file" (top-level-check) (return-stream-driver-code var filename reader :file generate)) (install-clause-info (quote (for :in-file)) (quote (for :in-file &optional :using)) (quote clause-for-in-file-6) "Forms in a file" t) (quote (for var in-file filename &optional using (reader (quote (function read))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(ematch0 slots ((list) nil) ((list* (list name pattern) rest) (list* (list name pattern) (parse-slots rest))) ((list something) (etypecase something (keyword (error "the last slot is a keyword!")) (symbol (list (list something something))))) ((list something next) (etypecase something (keyword (list (list something next))) (symbol (list* (list something something) (parse-slots (list next)))))) ((list* something next rest) (etypecase something (keyword (list* (list something next) (parse-slots rest))) (symbol (list* (list something something) (parse-slots (list* next rest)))))))

Problem: Macro call that should be transformed by ematch0

Input: (ematch0 slots ((list) nil) ((list* (list name pattern) rest) (list* (list name pattern) (parse-slots rest))) ((list something) (etypecase something (keyword (error "the last slot is a keyword!")) (symbol (list (list something something))))) ((list something next) (etypecase something (keyword (list (list something next))) (symbol (list* (list something something) (parse-slots (list next)))))) ((list* something next rest) (etypecase something (keyword (list* (list something next) (parse-slots rest))) (symbol (list* (list something something) (parse-slots (list* next rest)))))))

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

(match0 slots ((list) nil) ((list* (list name pattern) rest) (list* (list name pattern) (parse-slots rest))) ((list something) (etypecase something (keyword (error "the last slot is a keyword!")) (symbol (list (list something something))))) ((list something next) (etypecase something (keyword (list (list something next))) (symbol (list* (list something something) (parse-slots (list next)))))) ((list* something next rest) (etypecase something (keyword (list* (list something next) (parse-slots rest))) (symbol (list* (list something something) (parse-slots (list* next rest)))))) (_ (error "level0 match error!")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defstore example (a &rest args))

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

Input: (defstore example (a &rest args))

Output:
(defmacro defstore (store-name store-lambda-list &body body &environment env)
  (let* ((store-class-name (second (find :store-class body :key #'first)))
         (store-class (etypecase store-class-name
                        (null (find-class 'standard-store))
                        (symbol (find-class store-class-name))))
         (form (apply #'defstore-using-class store-class store-name store-lambda-list
                      :environment env
                      (mapcan #'(lambda (item)
                                  (cond ((eql (first item) :store-class)
                                         `(:store-class ',store-class-name))
                                        ((and (member (first item) '(:documentation :specialization-class)))
                                         (if (= 2 (length item))
                                             item
                                             (error "Invalid store definition option: ~W." item)))
                                        (t
                                         (list (first item) (rest item)))))
                              body))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,form)))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (ensure-store (quote example) (quote (a &rest args)))))


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

Problem: Macro call that should be transformed by DEFJSMACRO

Input: (defjsmacro nil nil)

Output: (defmacro DEFJSMACRO ...)


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

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

Input:
(with-yield
  nil
  (progn))

Output: (defmacro WITH-YIELD ...)

(isolate-cont
  (enable-yield
    nil
    nil
    (progn)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-alias-binding nconc nconcing)

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

Input: (define-alias-binding nconc nconcing)

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

(progn (setf (binding (quote nconc)) (quote nconcing)) (quote nconc))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(match* (s1 s2) (((list* (list 'eql o1) s1) (list* (list 'eql o2) s2)) (if (eql o1 o2) (specializer< s1 s2) :equal)) (((list* (list 'eql _) _) _) :less) ((_ (list* (list 'eql _) _)) :greater) (((list* type1 s1) (list* type2 s2)) (let ((class1 (find-class type1)) (class2 (find-class type2))) (ensure-finalized class1) (ensure-finalized class2) (let ((prec1 (rest (class-precedence-list class1))) (prec2 (rest (class-precedence-list class2)))) (cond ((member class2 prec1) :less) ((member class1 prec2) :greater) ((eq class1 class2) (specializer< s1 s2)) (t (or (when (and s1 s2) (let ((order (specializer< s1 s2))) (unless (eq order :equal) order))) (if (string< (class-name class1) (class-name class2)) :less :greater))))))))

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

Input: (match* (s1 s2) (((list* (list 'eql o1) s1) (list* (list 'eql o2) s2)) (if (eql o1 o2) (specializer< s1 s2) :equal)) (((list* (list 'eql _) _) _) :less) ((_ (list* (list 'eql _) _)) :greater) (((list* type1 s1) (list* type2 s2)) (let ((class1 (find-class type1)) (class2 (find-class type2))) (ensure-finalized class1) (ensure-finalized class2) (let ((prec1 (rest (class-precedence-list class1))) (prec2 (rest (class-precedence-list class2)))) (cond ((member class2 prec1) :less) ((member class1 prec2) :greater) ((eq class1 class2) (specializer< s1 s2)) (t (or (when (and s1 s2) (let ((order (specializer< s1 s2))) (unless (eq order :equal) order))) (if (string< (class-name class1) (class-name class2)) :less :greater))))))))

Output:
(defmacro match* ((&rest things) &body clauses)
  `(multiple-value-match (values ,@things)
     ,@clauses))

(multiple-value-match (values s1 s2) (((list* (list (quote eql) o1) s1) (list* (list (quote eql) o2) s2)) (if (eql o1 o2) (specializer< s1 s2) :equal)) (((list* (list (quote eql) _) _) _) :less) ((_ (list* (list (quote eql) _) _)) :greater) (((list* type1 s1) (list* type2 s2)) (let ((class1 (find-class type1)) (class2 (find-class type2))) (ensure-finalized class1) (ensure-finalized class2) (let ((prec1 (rest (class-precedence-list class1))) (prec2 (rest (class-precedence-list class2)))) (cond ((member class2 prec1) :less) ((member class1 prec2) :greater) ((eq class1 class2) (specializer< s1 s2)) (t (or (when (and s1 s2) (let ((order (specializer< s1 s2))) (unless (eq order :equal) order))) (if (string< (class-name class1) (class-name class2)) :less :greater))))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time form-callees (form environment) (walk #'(lambda (form form-type) (case form-type ((function-symbol function-setf) (list (second form))) ((symbol-call setf-call) (list (first form))) (otherwise '()))) #'(lambda (&optional (x nil x?) y) (if x? (union x y :test #'equal) '())) t nil t form environment))

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

Input: (defun-compile-time form-callees (form environment) (walk #'(lambda (form form-type) (case form-type ((function-symbol function-setf) (list (second form))) ((symbol-call setf-call) (list (first form))) (otherwise '()))) #'(lambda (&optional (x nil x?) y) (if x? (union x y :test #'equal) '())) t nil t form 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 form-callees (form environment) (walk (function (lambda (form form-type) (case form-type ((function-symbol function-setf) (list (second form))) ((symbol-call setf-call) (list (first form))) (otherwise (quote nil))))) (function (lambda (&optional (x nil x?) y) (if x? (union x y :test (function equal)) (quote nil)))) t nil t form environment)) (eval-when (:compile-toplevel) (compile (quote form-callees))))


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

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

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

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

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


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

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

Input: (->> 'some-name)

Output: (defmacro ->> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(is (stringp s))

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

Input: (is (stringp s))

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 ((#:v255 s)) (if (stringp #:v255) (add-result (quote test-passed) :test-expr (quote (stringp s))) (process-failure (quote (stringp s)) "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%" (quote s) #:v255 (quote stringp))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defstore example (&rest args))

Issue: Macro call that should be transformed by defstore

Input: (defstore example (&rest args))

Output:
(defmacro defstore (store-name store-lambda-list &body body &environment env)
  (let* ((store-class-name (second (find :store-class body :key #'first)))
         (store-class (etypecase store-class-name
                        (null (find-class 'standard-store))
                        (symbol (find-class store-class-name))))
         (form (apply #'defstore-using-class store-class store-name store-lambda-list
                      :environment env
                      (mapcan #'(lambda (item)
                                  (cond ((eql (first item) :store-class)
                                         `(:store-class ',store-class-name))
                                        ((and (member (first item) '(:documentation :specialization-class)))
                                         (if (= 2 (length item))
                                             item
                                             (error "Invalid store definition option: ~W." item)))
                                        (t
                                         (list (first item) (rest item)))))
                              body))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,form)))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (ensure-store (quote example) (quote (&rest args)))))


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

Issue: Macro call that should be transformed by MVLET*

Input:
(mvlet* nil
  nil)

Output: (defmacro MVLET* ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(do-notation bind-either ((sum (inc-either 1)) (str (either->string sum))) str)

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

Input: (do-notation bind-either ((sum (inc-either 1)) (str (either->string sum))) str)

Output:
(defmacro do-notation (bind-function expressions &body body)
  "Given a BIND-FUNCTION and all the bind expressions, evaluate BODY."
  `(progn
     ,@(reduce (lambda (acc do-binding)
		 (append `((,bind-function (lambda (,(car do-binding)) ,@acc)
					   ,@(cdr do-binding)))))
	       (reverse expressions)
	       :initial-value body)))

(progn (bind-either (lambda (sum) (bind-either (lambda (str) str) (either->string sum))) (inc-either 1)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-option-expander documentation (package documentation) (setf (documentation package T) documentation))

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

Input: (define-option-expander documentation (package documentation) (setf (documentation package T) documentation))

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

(defmethod expand-option ((#:type124 (eql :documentation)) package #:args123) (destructuring-bind (documentation) #:args123 (setf (documentation package t) documentation)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(static-dispatch-test-hook)

Problem: Macro call that should be transformed by static-dispatch-test-hook

Input: (static-dispatch-test-hook)

Output:
(defmacro static-dispatch-test-hook ()
  "A form of this macro is inserted in the output of the
   STATIC-DISPATCH compiler macro, in order to allow certain test code
   to be inserted, by shadowing this macro using MACROLET. The
   global expands to NIL."

  nil)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-effective-qualifier generic-function qualifier `(progn (%load-specializers-to-table ,generic-function ,type-list ,qualifier) ,(remove :unqualified `(defmethod ,generic-function ,qualifier ,descriptive-lambda-list ,@body) :end (if (eql :unqualified qualifier) 3 0))))

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

Input: (with-effective-qualifier generic-function qualifier `(progn (%load-specializers-to-table ,generic-function ,type-list ,qualifier) ,(remove :unqualified `(defmethod ,generic-function ,qualifier ,descriptive-lambda-list ,@body) :end (if (eql :unqualified qualifier) 3 0))))

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

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

(let ((qualifier (effective-qualifier generic-function qualifier))) (sb-int:quasiquote (progn (%load-specializers-to-table #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr qualifier :kind 0)) #S(sb-impl::comma :expr (remove :unqualified (sb-int:quasiquote (defmethod #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2))) :end (if (eql :unqualified qualifier) 3 0)) :kind 0))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-option-expander local-nicknames (package &rest nicknames) (loop for (nickname name) in nicknames do (trivial-package-local-nicknames:add-package-local-nickname nickname name package)))

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

Input: (define-option-expander local-nicknames (package &rest nicknames) (loop for (nickname name) in nicknames do (trivial-package-local-nicknames:add-package-local-nickname nickname name package)))

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

(defmethod expand-option ((#:type140 (eql :local-nicknames)) package #:args139) (destructuring-bind (&rest nicknames) #:args139 (loop for (nickname name) in nicknames do (sb-ext:add-package-local-nickname nickname name package))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(switch (13 :test =) (12 :oops) (13.0 :yay))

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

Input: (switch (13 :test =) (12 :oops) (13.0 :yay))

Output:
(defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
                         &body clauses)
  "Evaluates first matching clause, returning its values, or evaluates and
returns the values of T or OTHERWISE if no keys match."
  (generate-switch-body whole object clauses test key))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(action (:traverse node-for node new-subs) (let ((loop-subs new-subs)) (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :do (when (find name subs :key #'ast-substitution-from) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-for" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-for-binding-type binding) :value (gensym (symbol-name name)))) loop-subs))) (make-node-for :type (node-type node) :label (node-for-label node) :bindings (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :collect (make-node-for-binding :name (if rename-bound-variables (node-variable-value (ast-substitution-to (find name loop-subs :key #'ast-substitution-from))) name) :type (node-for-binding-type binding) :init (funcall *traverse* (node-for-binding-init binding) new-subs) :step (and (node-for-binding-step binding) (funcall *traverse* (node-for-binding-step binding) loop-subs)))) :sequential-p (node-for-sequential-p node) :returns (and (node-for-returns node) (funcall *traverse* (node-for-returns node) loop-subs)) :termination-kind (node-for-termination-kind node) :termination-expr (and (node-for-termination-expr node) (funcall *traverse* (node-for-termination-expr node) loop-subs)) :body (funcall *traverse* (node-for-body node) loop-subs))))

Problem: Macro call that should be transformed by action

Input: (action (:traverse node-for node new-subs) (let ((loop-subs new-subs)) (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :do (when (find name subs :key #'ast-substitution-from) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-for" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-for-binding-type binding) :value (gensym (symbol-name name)))) loop-subs))) (make-node-for :type (node-type node) :label (node-for-label node) :bindings (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :collect (make-node-for-binding :name (if rename-bound-variables (node-variable-value (ast-substitution-to (find name loop-subs :key #'ast-substitution-from))) name) :type (node-for-binding-type binding) :init (funcall *traverse* (node-for-binding-init binding) new-subs) :step (and (node-for-binding-step binding) (funcall *traverse* (node-for-binding-step binding) loop-subs)))) :sequential-p (node-for-sequential-p node) :returns (and (node-for-returns node) (funcall *traverse* (node-for-returns node) loop-subs)) :termination-kind (node-for-termination-kind node) :termination-expr (and (node-for-termination-expr node) (funcall *traverse* (node-for-termination-expr node) loop-subs)) :body (funcall *traverse* (node-for-body node) loop-subs))))

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 :traverse) (quote node-for) (lambda (node new-subs) (declare (type node-for node)) (let ((loop-subs new-subs)) (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :do (when (find name subs :key (function ast-substitution-from)) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-for" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-for-binding-type binding) :value (gensym (symbol-name name)))) loop-subs))) (make-node-for :type (node-type node) :label (node-for-label node) :bindings (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :collect (make-node-for-binding :name (if rename-bound-variables (node-variable-value (ast-substitution-to (find name loop-subs :key (function ast-substitution-from)))) name) :type (node-for-binding-type binding) :init (funcall *traverse* (node-for-binding-init binding) new-subs) :step (and (node-for-binding-step binding) (funcall *traverse* (node-for-binding-step binding) loop-subs)))) :sequential-p (node-for-sequential-p node) :returns (and (node-for-returns node) (funcall *traverse* (node-for-returns node) loop-subs)) :termination-kind (node-for-termination-kind node) :termination-expr (and (node-for-termination-expr node) (funcall *traverse* (node-for-termination-expr node) loop-subs)) :body (funcall *traverse* (node-for-body node) loop-subs)))))


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

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

Input: (defsynonym :search :find)

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

(eval-always (setf (get (quote :search) (quote synonym)) (quote :find)))


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

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

Input:
(with nil
  :key
  nil)

Output: (defmacro WITH ...)


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

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

Input: (check-declaration-env nil)

Output: (defmacro CHECK-DECLARATION-ENV ...)

(let ()
  (let ((#:new120 (%check-declaration-env nil nil nil)))
    (setq nil #:new120)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(alet (1+ 1) (1+ it))

Problem: Macro call that should be transformed by alet

Input: (alet (1+ 1) (1+ it))

Output:
(defmacro alet (form &body body)
  "Binds the FORM to IT (via LET) in the scope of the BODY."
  `(anaphoric ignore-first ,form (progn ,@body)))

(anaphoric ignore-first (1+ 1) (progn (1+ it)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(augment free-vars (free-vars (second binding) bound-vars))

Issue: Macro call that should be transformed by augment

Input: (augment free-vars (free-vars (second binding) bound-vars))

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

(setf free-vars (nconc free-vars (free-vars (second binding) bound-vars)))


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

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

Input:
(with-dynenv nil
  nil)

Output: (defmacro WITH-DYNENV ...)

(multiple-value-bind (#:var-expansion126 #:var-expanded-p127)
    (macroexpand-1 'var-space nil)
  (multiple-value-bind (#:fun-expansion128 #:fun-expanded-p129)
      (macroexpand-1 'fun-space nil)
    (let ((*var-space* (when #:var-expanded-p127 #:var-expansion126))
          (*fun-space* (when #:fun-expanded-p129 #:fun-expansion128))
          (*within-captured-dynenv* t))
      nil)))


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

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

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

Output:
(defmacro define-method-combination (name &rest args)
  `(progn
     (define-method-combination% ,name ,@args)
     (c2mop:define-method-combination ,name ,@args)))

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-component dot :input-type "dot" :output-type "png" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run `("dot" "-Tpng" ,input-pathname "-o" ,output-pathname) :show t)))

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

Input: (define-component dot :input-type "dot" :output-type "png" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run `("dot" "-Tpng" ,input-pathname "-o" ,output-pathname) :show t)))

Output:
(defmacro define-component (name &key input-type output-type compile-function)
  "Define an ASDF component."
  `(progn
     (defclass ,name (source-file)
       ((type :initform ,input-type)
        (output :reader output :initarg :output)))

     (defmethod perform ((o load-op) (component ,name)) t)

     (defmethod output-files ((operation compile-op) (component ,name))
       (list
        (output-pathname component ,output-type)))

     (defmethod perform ((o compile-op) (component ,name))
       (funcall ,compile-function
                (component-pathname component)
                (output-pathname component ,output-type)))

     (import ',name :asdf)))

(progn (defclass dot (source-file) ((type :initform "dot") (output :reader output :initarg :output))) (defmethod perform ((o load-op) (component dot)) t) (defmethod output-files ((operation compile-op) (component dot)) (list (output-pathname component "png"))) (defmethod perform ((o compile-op) (component dot)) (funcall (lambda (input-pathname output-pathname) (inferior-shell:run (sb-int:quasiquote ("dot" "-Tpng" #S(sb-impl::comma :expr input-pathname :kind 0) "-o" #S(sb-impl::comma :expr output-pathname :kind 0))) :show t)) (component-pathname component) (output-pathname component "png"))) (import (quote dot) :asdf))


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

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

Input: (collect-max nil (progn))

Output: (defmacro COLLECT-MAX ...)

(common-lisp:let* ((#:generator-366 (generator (progn)))
                   #:items-356
                   (#:generator-364 (generator nil))
                   #:numbers-355
                   (#:number-358 nil)
                   #:result-359)
  (declare (type generator #:generator-366)
           (type generator #:generator-364)
           (type (null-or t) #:result-359))
  (tagbody
   #:ll-367
    (setq #:items-356 (next-in #:generator-366 (go end)))
    (setq #:numbers-355 (next-in #:generator-364 (go end)))
    (if (or (null #:number-358) (< #:number-358 #:numbers-355))
        (setq #:number-358 #:numbers-355
              #:result-359 #:items-356))
    (go #:ll-367)
   end)
  (if (null #:number-358)
      (setq #:result-359 nil))
  #:result-359)


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

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

Input:
(unwind-protect nil
    :key
  nil)

Output: (defmacro UNWIND-PROTECT ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-comparison-ops == = < < > > <= <= >= >=)

Issue: Macro call that should be transformed by define

Input: (define-comparison-ops == = < < > > <= <= >= >=)

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

(progn (progn (defmethod vacietis.c:== ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (= (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod vacietis.c:== ((x number) (y number)) (if (= x y) 1 0))) (progn (defmethod vacietis.c:< ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (< (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod vacietis.c:< ((x number) (y number)) (if (< x y) 1 0))) (progn (defmethod vacietis.c:> ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (> (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod vacietis.c:> ((x number) (y number)) (if (> x y) 1 0))) (progn (defmethod vacietis.c:<= ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (<= (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod vacietis.c:<= ((x number) (y number)) (if (<= x y) 1 0))) (progn (defmethod vacietis.c:>= ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (>= (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod vacietis.c:>= ((x number) (y number)) (if (>= x y) 1 0))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause for (var-or-vars iteration &environment env) "General iteration clause. Its actual behaviour is controlled by ITERATION, a macro form that FOR expands with *ITERATION-VARIABLE* bound to VAR. Example: in (for x (in '(1 2 3))), IN is a macro that expands into clauses that make use of *ITERATION-VARIABLE*, which is bound to the symbol X in the example. For certain iteration macros, VAR can be a lambda-list as well, in which case destructuring is applied. Example: (for (x &optional y) (in-list '((1 2) (3))))." (let ((*iteration-variable* var-or-vars)) (macroexpand iteration env)))

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

Input: (defclause for (var-or-vars iteration &environment env) "General iteration clause. Its actual behaviour is controlled by ITERATION, a macro form that FOR expands with *ITERATION-VARIABLE* bound to VAR. Example: in (for x (in '(1 2 3))), IN is a macro that expands into clauses that make use of *ITERATION-VARIABLE*, which is bound to the symbol X in the example. For certain iteration macros, VAR can be a lambda-list as well, in which case destructuring is applied. Example: (for (x &optional y) (in-list '((1 2) (3))))." (let ((*iteration-variable* var-or-vars)) (macroexpand iteration env)))

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

(progn (defmacro for (var-or-vars iteration &environment env) "General iteration clause. Its actual behaviour is controlled by ITERATION, a macro form that FOR expands with *ITERATION-VARIABLE* bound to VAR. Example: in (for x (in '(1 2 3))), IN is a macro that expands into clauses that make use of *ITERATION-VARIABLE*, which is bound to the symbol X in the example. For certain iteration macros, VAR can be a lambda-list as well, in which case destructuring is applied. Example: (for (x &optional y) (in-list '((1 2) (3))))." (let ((*iteration-variable* var-or-vars)) (macroexpand iteration env))) (pushnew (quote for) *clauses*))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym reducing :reduce)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym reducing :reduce)

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

(eval-always (setf (get (quote reducing) (quote synonym)) (quote :reduce)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-custom-var (:object-scope *object-scope-variables*) '(*internal-decoder*) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Object.")

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

Input: (define-custom-var (:object-scope *object-scope-variables*) '(*internal-decoder*) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Object.")

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*object-scope-variables* . :object-scope)) *custom-vars* :test (function equal)) (defvar *object-scope-variables* (quote (*internal-decoder*)) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Object.")))


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

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

Input: (lambda-match)

Output: (defmacro LAMBDA-MATCH ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(define _IOLBF 2)

Issue: Macro call that should be transformed by define

Input: (define _IOLBF 2)

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is (= 2 (add-2 0)))

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

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

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

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

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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-autoload-on-missing (let ((*standard-output* (make-broadcast-stream)) (*error-output* (make-broadcast-stream))) (asdf:load-system driver-system :verbose nil)))

Problem: Macro call that should be transformed by with-autoload-on-missing

Input: (with-autoload-on-missing (let ((*standard-output* (make-broadcast-stream)) (*error-output* (make-broadcast-stream))) (asdf:load-system driver-system :verbose nil)))

Output:
(defmacro with-autoload-on-missing (&body body)
  (let ((retrying (gensym))
        (e (gensym)))
    `(let ((,retrying (make-hash-table :test 'equal)))
       (handler-bind ((asdf:missing-component
                        (lambda (,e)
                          (unless (gethash (asdf::missing-requires ,e) ,retrying)
                            (setf (gethash (asdf::missing-requires ,e) ,retrying) t)
                            (when (find :quicklisp *features*)
                              (uiop:symbol-call '#:ql-dist '#:ensure-installed
                                                (uiop:symbol-call '#:ql-dist '#:find-system
                                                                  (asdf::missing-requires ,e)))
                              (invoke-restart (find-restart 'asdf:retry ,e)))))))
         ,@body))))

(let ((#:g158 (make-hash-table :test (quote equal)))) (handler-bind ((asdf/find-component:missing-component (lambda (#:g159) (unless (gethash (asdf/find-component:missing-requires #:g159) #:g158) (setf (gethash (asdf/find-component:missing-requires #:g159) #:g158) t) (when (find :quicklisp *features*) (uiop/package:symbol-call (quote #:ql-dist) (quote #:ensure-installed) (uiop/package:symbol-call (quote #:ql-dist) (quote #:find-system) (asdf/find-component:missing-requires #:g159))) (invoke-restart (find-restart (quote asdf/session:retry) #:g159))))))) (let ((*standard-output* (make-broadcast-stream)) (*error-output* (make-broadcast-stream))) (asdf/operate:load-system driver-system :verbose nil))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-prepared-query query (conn (format nil "SELECT pg_get_viewdef('~A'::regclass) AS def" table-name)) (let ((results (dbi:execute query))) (string-right-trim '(#\Space #\;) (string-left-trim '(#\Space) (first (first (dbi:fetch-all results :format :values)))))))

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

Input: (with-prepared-query query (conn (format nil "SELECT pg_get_viewdef('~A'::regclass) AS def" table-name)) (let ((results (dbi:execute query))) (string-right-trim '(#\Space #\;) (string-left-trim '(#\Space) (first (first (dbi:fetch-all results :format :values)))))))

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 pg_get_viewdef('~A'::regclass) AS def" table-name) (lambda (query) (let ((results (dbi.driver:execute query))) (string-right-trim (quote (#\Space #\SEMICOLON)) (string-left-trim (quote (#\Space)) (first (first (dbi.driver:fetch-all results :format :values))))))) :use-prepare-cached nil)


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

Problem: Macro call that should be transformed by COEXIT!

Input: (coexit!)

Output: (defmacro COEXIT! ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(-> :g (a) (values (+ a 5) -1))

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

Input: (-> :g (a) (values (+ a 5) -1))

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-hook (:build uiop) () (unless uiop/image:*image-dumped-p* (setf uiop/image:*image-dumped-p* T) (setf uiop/image::*image-restored-p* :in-regress) (uiop/image:call-image-dump-hook) (setf uiop/image::*image-restored-p* NIL)))

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

Input: (define-hook (:build uiop) () (unless uiop/image:*image-dumped-p* (setf uiop/image:*image-dumped-p* T) (setf uiop/image::*image-restored-p* :in-regress) (uiop/image:call-image-dump-hook) (setf uiop/image::*image-restored-p* NIL)))

Output:
(defmacro define-hook ((type name &optional (priority 0)) args &body body)
  (ecase type (:pre-load) (:load) (:build) (:deploy) (:boot) (:quit))
  (check-type name symbol)
  `(let ((,name (or (hook ,type ',name)
                    (make-instance 'hook :name ',name :type ,type))))
     (setf (hook-priority ,name) ,priority)
     (setf (hook-function ,name) (flet ((,name (&key ,@args &allow-other-keys)
                                          ,@body))
                                   #',name))
     (setf (hook ,type ',name) ,name)
     (setf (docstring ,name) ,(if (stringp (car body)) (car body)))
     ',name))

(let ((uiop (or (hook :build (quote uiop)) (make-instance (quote hook) :name (quote uiop) :type :build)))) (setf (hook-priority uiop) 0) (setf (hook-function uiop) (flet ((uiop (&key &allow-other-keys) (unless uiop/image:*image-dumped-p* (setf uiop/image:*image-dumped-p* t) (setf uiop/image::*image-restored-p* :in-regress) (uiop/image:call-image-dump-hook) (setf uiop/image::*image-restored-p* nil)))) (function uiop))) (setf (hook :build (quote uiop)) uiop) (setf (docstring uiop) nil) (quote uiop))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause from (initial-value &key to by while (using ''+)) "Iterates from a given initial value to an optional maximum. Every iteration increments/decrements the value applying the <using> function (by default +) to the previous value and <by> (by default 1 or -1, depending on whether to >= from or not). Similarly, the <while> function is used to determine if <to> has been reached or surpassed. <while> is a function of two arguments, the current value and the value of <to>, and as soon as it returns false, the loop is terminated. <while> defaults to a function that returns true only if <to> has been specified and, letting cur be the current value, (<= (min to from) cur (max to from))." (let* ((diff (gensym "FROM-DIFF")) (to-evaled (gensym "FROM-TO")) (initial-evaled (gensym "FROM-FROM")) (while (or while (when to `(lambda (cur to &aux (from ,initial-evaled)) (let ((max (max to from)) (min (min to from))) (<= min cur max))))))) (list (make-simple-iteration :var to-evaled :init to) (make-simple-iteration :var initial-evaled :init initial-value) (make-simple-iteration :var diff :init (if by by `(if ,to-evaled (let ((signum (signum (- ,to-evaled ,initial-evaled)))) (if (zerop signum) +1 signum)) +1))) (make-initialization :form `(when (and ,to-evaled (not (zerop (- ,to-evaled ,initial-evaled))) (not (= (signum (- ,to-evaled ,initial-evaled)) (signum ,diff)))) (terminate))) (make-simple-iteration :init initial-evaled :step `(funcall ,using ,*iteration-variable* ,diff) :postcondition (when while `(funcall ,while ,*iteration-variable* ,to-evaled))))))

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

Input: (defclause from (initial-value &key to by while (using ''+)) "Iterates from a given initial value to an optional maximum. Every iteration increments/decrements the value applying the <using> function (by default +) to the previous value and <by> (by default 1 or -1, depending on whether to >= from or not). Similarly, the <while> function is used to determine if <to> has been reached or surpassed. <while> is a function of two arguments, the current value and the value of <to>, and as soon as it returns false, the loop is terminated. <while> defaults to a function that returns true only if <to> has been specified and, letting cur be the current value, (<= (min to from) cur (max to from))." (let* ((diff (gensym "FROM-DIFF")) (to-evaled (gensym "FROM-TO")) (initial-evaled (gensym "FROM-FROM")) (while (or while (when to `(lambda (cur to &aux (from ,initial-evaled)) (let ((max (max to from)) (min (min to from))) (<= min cur max))))))) (list (make-simple-iteration :var to-evaled :init to) (make-simple-iteration :var initial-evaled :init initial-value) (make-simple-iteration :var diff :init (if by by `(if ,to-evaled (let ((signum (signum (- ,to-evaled ,initial-evaled)))) (if (zerop signum) +1 signum)) +1))) (make-initialization :form `(when (and ,to-evaled (not (zerop (- ,to-evaled ,initial-evaled))) (not (= (signum (- ,to-evaled ,initial-evaled)) (signum ,diff)))) (terminate))) (make-simple-iteration :init initial-evaled :step `(funcall ,using ,*iteration-variable* ,diff) :postcondition (when while `(funcall ,while ,*iteration-variable* ,to-evaled))))))

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

(progn (defmacro from (initial-value &key to by while (using (quote (quote +)))) "Iterates from a given initial value to an optional maximum. Every iteration increments/decrements the value applying the <using> function (by default +) to the previous value and <by> (by default 1 or -1, depending on whether to >= from or not). Similarly, the <while> function is used to determine if <to> has been reached or surpassed. <while> is a function of two arguments, the current value and the value of <to>, and as soon as it returns false, the loop is terminated. <while> defaults to a function that returns true only if <to> has been specified and, letting cur be the current value, (<= (min to from) cur (max to from))." (let* ((diff (gensym "FROM-DIFF")) (to-evaled (gensym "FROM-TO")) (initial-evaled (gensym "FROM-FROM")) (while (or while (when to (sb-int:quasiquote (lambda (cur to &aux (from #S(sb-impl::comma :expr initial-evaled :kind 0))) (let ((max (max to from)) (min (min to from))) (<= min cur max)))))))) (list (make-simple-iteration :var to-evaled :init to) (make-simple-iteration :var initial-evaled :init initial-value) (make-simple-iteration :var diff :init (if by by (sb-int:quasiquote (if #S(sb-impl::comma :expr to-evaled :kind 0) (let ((signum (signum (- #S(sb-impl::comma :expr to-evaled :kind 0) #S(sb-impl::comma :expr initial-evaled :kind 0))))) (if (zerop signum) 1 signum)) 1)))) (make-initialization :form (sb-int:quasiquote (when (and #S(sb-impl::comma :expr to-evaled :kind 0) (not (zerop (- #S(sb-impl::comma :expr to-evaled :kind 0) #S(sb-impl::comma :expr initial-evaled :kind 0)))) (not (= (signum (- #S(sb-impl::comma :expr to-evaled :kind 0) #S(sb-impl::comma :expr initial-evaled :kind 0))) (signum #S(sb-impl::comma :expr diff :kind 0))))) (terminate)))) (make-simple-iteration :init initial-evaled :step (sb-int:quasiquote (funcall #S(sb-impl::comma :expr using :kind 0) #S(sb-impl::comma :expr *iteration-variable* :kind 0) #S(sb-impl::comma :expr diff :kind 0))) :postcondition (when while (sb-int:quasiquote (funcall #S(sb-impl::comma :expr while :kind 0) #S(sb-impl::comma :expr *iteration-variable* :kind 0) #S(sb-impl::comma :expr to-evaled :kind 0)))))))) (pushnew (quote from) *clauses*))


Instruction:
Generate a defmacro form that transforms code like this:
;; Exporting closure variables requires building pandoric protocol manually
(let ((a 0))
  (let ((b 1))
    (let (this self)
      (setq
        this (lambda (n) (incf a n) (setq b (* b n)))
        self (dlambda
               (:pandoric-get (sym)
                 (case sym
                   ((a) a)
                   ((b) b)
                   (t (error "Unknown: ~a" sym))))
               (:pandoric-set (sym val)
                 (case sym
                   ((a) (setq a val))
                   ((b) (setq b val))))
               (t (&rest args) (apply this args)))))))

;; Manual self construction for every closure is painful

Pattern to recognize: Need to export closure variables through pandoric protocol, but manually building the self dlambda for each set of variables is repetitive

Input:
;; Exporting closure variables requires building pandoric protocol manually
(let ((a 0))
  (let ((b 1))
    (let (this self)
      (setq
        this (lambda (n) (incf a n) (setq b (* b n)))
        self (dlambda
               (:pandoric-get (sym)
                 (case sym
                   ((a) a)
                   ((b) b)
                   (t (error "Unknown: ~a" sym))))
               (:pandoric-set (sym val)
                 (case sym
                   ((a) (setq a val))
                   ((b) (setq b val))))
               (t (&rest args) (apply this args)))))))

;; Manual self construction for every closure is painful

Output:
(defmacro plambda (largs pargs &rest body)
  (let ((pargs (mapcar #'list pargs)))
    `(let (this self)
       (setq
         this (lambda ,largs ,@body)
         self (dlambda
                (:pandoric-get (sym)
                  ,(pandoriclet-get pargs))
                (:pandoric-set (sym val)
                  ,(pandoriclet-set pargs))
                (t (&rest args)
                  (apply this args)))))))

;; (let ((a 0))
;;   (let ((b 1))
;;     (plambda (n) (a b)
;;       (incf a n)
;;       (setq b (* b n)))))
;;
;; Now:
;; (with-pandoric (a b) closure
;;   (format t "a=~a b=~a~%" a b))
;; a and b are accessible through the pandoric protocol


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> +comment+ +skip-all-space+)

Issue: Macro call that should be transformed by *>

Input: (*> +comment+ +skip-all-space+)

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

(lambda (#:*>-offset248) (multiple-value-bind (#:*>-res249 #:*>-next250) (funcall +comment+ #:*>-offset248) (if (ok? #:*>-res249) (funcall +skip-all-space+ #:*>-next250) (fail #:*>-next250))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(if-generator (vals gen) (loop for val in vals for j from 0 do (push val (elt stor j))) (if fail-if-short (error 'insufficient-items :format-control "Insufficient items in generator") (return (apply #'values (mapcar #'reverse stor)))))

Issue: Macro call that should be transformed by if-generator

Input: (if-generator (vals gen) (loop for val in vals for j from 0 do (push val (elt stor j))) (if fail-if-short (error 'insufficient-items :format-control "Insufficient items in generator") (return (apply #'values (mapcar #'reverse stor)))))

Output:
(defmacro if-generator ((var gen) true-clause &optional false-clause)
  "Pulls a single iteration out of gen. If a single var is specified, it places all the values from the iteration in a list under var. If var is a list, destructures values into the vars in the list. If the generator has stopped, evaluates false-clause, otherwise evaluates true-clause."
  `(,@(if (listp var)
	 `(multiple-value-bind ,var
	      (funcall ,gen))
	 `(let ((,var (multiple-value-list (funcall ,gen))))))
      (if (eq 'generator-stop
	      ,(if (listp var)
		   (car var)
		   `(car ,var)))
	  ,false-clause
	  ,true-clause)))

(let ((vals (multiple-value-list (funcall gen)))) (if (eq (quote generator-stop) (car vals)) (if fail-if-short (error (quote insufficient-items) :format-control "Insufficient items in generator") (return (apply (function values) (mapcar (function reverse) stor)))) (loop for val in vals for j from 0 do (push val (elt stor j)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(enable-case-preserving-syntax)

Write a macro that addresses: Macro call that should be transformed by ENABLE-CASE-PRESERVING-SYNTAX

Input: (enable-case-preserving-syntax)

Output: (defmacro ENABLE-CASE-PRESERVING-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-case-preserving-syntax-in-readtable :start-character #\COMMA
                                           :dispatch-character #\NUMBER_SIGN
                                           :readtable-case :preserve :packages
                                           nil)
  (values))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(if-it (mismatch suffix string :from-end t :test test :end2 (when -end (- (length string) -end))) (zerop it) t)

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

Input: (if-it (mismatch suffix string :from-end t :test test :end2 (when -end (- (length string) -end))) (zerop it) t)

Output:
(defmacro if-it (test then &optional else)
  "Like IF. IT is bound to TEST."
  `(let ((it ,test))
     (if it ,then ,else)))

(let ((it (mismatch suffix string :from-end t :test test :end2 (when -end (- (length string) -end))))) (if it (zerop it) t))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(enable-feature-cond-syntax)

Problem: Macro call that should be transformed by ENABLE-FEATURE-COND-SYNTAX

Input: (enable-feature-cond-syntax)

Output: (defmacro ENABLE-FEATURE-COND-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-feature-cond-syntax-in-readtable :start-character #\ASTERISK
                                        :dispatch-character #\NUMBER_SIGN
                                        :end-character nil :readtable-case nil)
  (values))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(macroexpand-convention (form) (if (consp form) (expand-export-structure-using-head (first form) form) form))

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

Input: (macroexpand-convention (form) (if (consp form) (expand-export-structure-using-head (first form) form) form))

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

(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-export-structure-using-head (first form) form) form)) (values result (or expanded-p (not (eq result form)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do-notation bind-either ((sum (left 1)) (str (either->string sum))) (print str))

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

Input: (do-notation bind-either ((sum (left 1)) (str (either->string sum))) (print str))

Output:
(defmacro do-notation (bind-function expressions &body body)
  "Given a BIND-FUNCTION and all the bind expressions, evaluate BODY."
  `(progn
     ,@(reduce (lambda (acc do-binding)
		 (append `((,bind-function (lambda (,(car do-binding)) ,@acc)
					   ,@(cdr do-binding)))))
	       (reverse expressions)
	       :initial-value body)))

(progn (bind-either (lambda (sum) (bind-either (lambda (str) (print str)) (either->string sum))) (left 1)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defjs map1() (if (< this.k 90) (emit this.name 1) (emit this.k 99)))

Problem: Macro call that should be transformed by defjs

Input: (defjs map1() (if (< this.k 90) (emit this.name 1) (emit this.k 99)))

Output:
(defmacro defjs (name args &body body)
  "Define client side javascript. Works like defun; body is in lisp, with parenscript
   additions, like return. So (defjs hello (x y) (return (+ x y))) defines an adder.
   macro creates a lisp function which sends the javascript function over to the mongo
   server to be evaluated. Result is processed and returned to the reader.
   This will execute 10 times on the server :
   (mapcar (lambda (x) (hello 10 x)) (list 1 2 3 4 5 6 7 8 9 10))"
  `(let* ((js-body (parenscript:ps (lambda ,args ,@body))))
     (setf (gethash ',name *js-definitions*) js-body)
     (defun ,name ,args
       (get-element "retval" (car (docs (db.eval js-body ,@args)))))))

(let* ((js-body (parenscript:ps (lambda nil (if (< this.k 90) (emit this.name 1) (emit this.k 99)))))) (setf (gethash (quote map1) *js-definitions*) js-body) (defun map1 nil (get-element "retval" (car (docs (db.eval js-body))))))


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

Problem: Macro call that should be transformed by DESTRUCTURING-BIND

Input: (destructuring-bind () :key nil)

Output: (defmacro DESTRUCTURING-BIND ...)

(sb-int:binding* ((nil (sb-c::check-ds-list :key 0 0 'nil)))
  nil)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when-let (x (opaque :ok)) (setf x (cons x x)) x)

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

Input: (when-let (x (opaque :ok)) (setf x (cons x x)) x)

Output:
(defmacro when-let (bindings &body forms)
    "Creates new variable bindings, and conditionally executes FORMS.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

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

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

If all variables were bound to true values, then FORMS are executed as an
implicit PROGN."
  (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
                           (list bindings)
                           bindings))
         (variables (mapcar #'car binding-list)))
    `(let ,binding-list
       (when (and ,@variables)
         ,@forms))))

(let ((x (opaque :ok))) (when (and x) (setf x (cons x x)) x))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defgenerator some-numbers () (loop for i from 1 upto 3 do (yield i)) (dotimes (j 3) (yield (- 10 j))))

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

Input: (defgenerator some-numbers () (loop for i from 1 upto 3 do (yield i)) (dotimes (j 3) (yield (- 10 j))))

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 some-numbers nil nil (with-yield (loop for i from 1 upto 3 do (yield i)) (dotimes (j 3) (yield (- 10 j)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-neo4j-fun create-relationship (node-id to-node-id relationship-type properties) :post (:uri-spec (format nil "node/~A/relationships" node-id)) (:encode (list to-node-id relationship-type properties) :relationship) (:status-handlers (201 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

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

Input: (def-neo4j-fun create-relationship (node-id to-node-id relationship-type properties) :post (:uri-spec (format nil "node/~A/relationships" node-id)) (:encode (list to-node-id relationship-type properties) :relationship) (:status-handlers (201 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

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

(progn (defun create-relationship (&key node-id to-node-id relationship-type properties) (let ((uri (format nil "node/~A/relationships" node-id)) (json (encode-neo4j-json-payload (list to-node-id relationship-type properties) :relationship))) (make-neo4j-request :post uri json (list (list 201 (lambda (body uri json) (decode-neo4j-json-output body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-slot-annotation optional (init-form) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (unless (plist-member slot-options :initform) (setf (getf slot-options :initform) init-form)))

Problem: Macro call that should be transformed by def-slot-annotation

Input: (def-slot-annotation optional (init-form) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (unless (plist-member slot-options :initform) (setf (getf slot-options :initform) init-form)))

Output:
(defmacro def-slot-annotation (name args &body body)
  (with-gensyms (slot-specifier)
    `(defannotation ,name ,(append args (list slot-specifier))
         (:inline t :arity ,(1+ (length args)))
       (destructuring-bind (slot-name . slot-options)
           (if (consp ,slot-specifier)
               ,slot-specifier
               (list ,slot-specifier))
         ,@body
         (cons slot-name slot-options)))))

(defannotation optional (init-form #:slot-specifier122) (:inline t :arity 2) (destructuring-bind (slot-name . slot-options) (if (consp #:slot-specifier122) #:slot-specifier122 (list #:slot-specifier122)) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (unless (plist-member slot-options :initform) (setf (getf slot-options :initform) init-form)) (cons slot-name slot-options)))


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

Issue: Macro call that should be transformed by F_

Input:
(f_
  nil)

Output: (defmacro F_ ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(action (:traverse node-let) #'propagate-constants-node-let)

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

Input: (action (:traverse node-let) #'propagate-constants-node-let)

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 :traverse) (quote node-let) (function propagate-constants-node-let))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(lret ((x 1) (y (make-array 1))) (setf (aref y 0) x))

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

Input: (lret ((x 1) (y (make-array 1))) (setf (aref y 0) x))

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

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

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

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

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

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

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

(lret-aux let ((x 1) (y (make-array 1))) (setf (aref y 0) x))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(make-stream-method pp-xml-value (s (value float) &optional colon-p at-p) (declare (ignore colon-p at-p)) (if (< (- (abs value) *precision-epsilon*) 0.00000001) (format s "0") (format s "~v$" *float-format-precision* value)))

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

Input: (make-stream-method pp-xml-value (s (value float) &optional colon-p at-p) (declare (ignore colon-p at-p)) (if (< (- (abs value) *precision-epsilon*) 0.00000001) (format s "0") (format s "~v$" *float-format-precision* value)))

Output:
(defmacro make-stream-method (name (s &rest args) &body body)
  `(progn
     (defmethod ,name ((,s stream) ,@args)
       ,@body)
     #+abcl
     (defmethod ,name ((,s xp::xp-structure) ,@args)
       ,@body)))

(progn (defmethod pp-xml-value ((s stream) (value float) &optional colon-p at-p) (declare (ignore colon-p at-p)) (if (< (- (abs value) *precision-epsilon*) 1.0e-8) (format s "0") (format s "~v$" *float-format-precision* value))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(is equal "A" (string :a))

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

Input: (is equal "A" (string :a))

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (is equal "A" (string :a))) :value-form (quote (string :a)) :body (lambda nil (string :a)) :expected "A" :comparison (quote equal)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when (typep (car evaluated) 'node) (setf asts evaluated))

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

Input: (when (typep (car evaluated) 'node) (setf asts evaluated))

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

(if (typep (car evaluated) (quote node)) (setf asts evaluated))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (eql (top-info) 'destructor) (format stream "~~"))

Problem: Macro call that should be transformed by when

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

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

(if (eql (top-info) (quote destructor)) (format stream "~~"))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-layered-class nil)

Issue: Macro call that should be transformed by DEFINE-LAYERED-CLASS

Input: (define-layered-class nil)

Output: (defmacro DEFINE-LAYERED-CLASS ...)

(defclass nil nil nil (:metaclass layered-class) (:in-layer . t))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-unique-names (body) (let ((body `(tagbody ,@(prologue-forms body-clause) ,@(step-intro-forms body-clause t) ,@(step-outro-forms body-clause t) ,body ,@(body-forms body-clause) ,@(step-intro-forms body-clause nil) ,@(step-outro-forms body-clause nil) (go ,body) ,*epilogue-tag* ,@(epilogue-forms body-clause) (return-from ,*loop-name* ,*accumulation-variable*))) (afterword (afterword-forms body-clause))) (if afterword `((unwind-protect ,body ,@afterword)) `(,body))))

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

Input: (with-unique-names (body) (let ((body `(tagbody ,@(prologue-forms body-clause) ,@(step-intro-forms body-clause t) ,@(step-outro-forms body-clause t) ,body ,@(body-forms body-clause) ,@(step-intro-forms body-clause nil) ,@(step-outro-forms body-clause nil) (go ,body) ,*epilogue-tag* ,@(epilogue-forms body-clause) (return-from ,*loop-name* ,*accumulation-variable*))) (afterword (afterword-forms body-clause))) (if afterword `((unwind-protect ,body ,@afterword)) `(,body))))

Output:
(defmacro with-unique-names (names &body body)
  `(let ,(mapcar (lambda (sym)
                   `(,sym (gensym ,(symbol-name sym))))
                  names)
     ,@body))

(let ((body (gensym #A((4) base-char . "BODY")))) (let ((body (quasiquote (tagbody #S(sb-impl::comma :expr (prologue-forms body-clause) :kind 2) #S(sb-impl::comma :expr (step-intro-forms body-clause t) :kind 2) #S(sb-impl::comma :expr (step-outro-forms body-clause t) :kind 2) #S(sb-impl::comma :expr body :kind 0) #S(sb-impl::comma :expr (body-forms body-clause) :kind 2) #S(sb-impl::comma :expr (step-intro-forms body-clause nil) :kind 2) #S(sb-impl::comma :expr (step-outro-forms body-clause nil) :kind 2) (go #S(sb-impl::comma :expr body :kind 0)) #S(sb-impl::comma :expr *epilogue-tag* :kind 0) #S(sb-impl::comma :expr (epilogue-forms body-clause) :kind 2) (return-from #S(sb-impl::comma :expr *loop-name* :kind 0) #S(sb-impl::comma :expr *accumulation-variable* :kind 0))))) (afterword (afterword-forms body-clause))) (if afterword (quasiquote ((unwind-protect #S(sb-impl::comma :expr body :kind 0) #S(sb-impl::comma :expr afterword :kind 2)))) (quasiquote (#S(sb-impl::comma :expr body :kind 0))))))


Instruction:
Generate a defmacro form that transforms code like this:
(macroexpand-convention (form) (if (consp form) (expand-export-form-using-head (first form) form) form))

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

Input: (macroexpand-convention (form) (if (consp form) (expand-export-form-using-head (first form) form) form))

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

(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-export-form-using-head (first form) form) form)) (values result (or expanded-p (not (eq result form)))))


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

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

Input: (in-package nil)

Output: (defmacro IN-PACKAGE ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (setq *package*
          (sb-int:find-undeleted-package-or-lose #A((3) base-char . "NIL"))))