Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) `(let ((,parent-type (or (find-coloring-type ,parent) (and ,parent (error "No such coloring type: ~S" ,parent))))) (setf (find-coloring-type ,name) (make-instance 'coloring-type :fancy-name ',fancy-name :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) :default-mode (or ',default-mode (if ,parent-type (coloring-type-default-mode ,parent-type))) ,@(if autodetect `(:autodetect-function ,autodetect)) :parent-type ,parent-type :visible (not ,invisible) :formatter-initial-values (lambda nil (list* ,@(mapcar #'(lambda (e) `(cons ',(car e) ,(second e))) formatter-variables) (if ,parent-type (funcall (coloring-type-formatter-initial-values ,parent-type)) nil))) :formatter-after-hook (lambda nil (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (concatenate 'string (funcall ,formatter-after-hook) (if ,parent-type (funcall (coloring-type-formatter-after-hook ,parent-type)) "")))) :term-formatter (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (lambda (,term) (labels ((call-parent-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (if ,parent-type (funcall (coloring-type-term-formatter ,parent-type) (cons ,type ,string)))) (call-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (funcall (case (first ,type) ,@formatters (t (lambda (,type text) (call-parent-formatter ,type text)))) ,type ,string))) (call-formatter)))) :transition-functions (list ,@(loop for transition in transitions collect (destructuring-bind (mode &rest table) transition `(cons ',mode (lambda (,current-mode ,string ,position) (let ((,mode-wait (constantly nil)) (,position-foobage ,position)) (with-scanning-functions ,string ,position-foobage ,current-mode ,mode-wait (let ((*reset-position* ,position)) (cond ,@table)) (values ,position-foobage ,current-mode (lambda (,new-position) (setf ,position-foobage ,new-position) (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) (values ,position-foobage ,advance))))) ))))))))))

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

Input: (with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) `(let ((,parent-type (or (find-coloring-type ,parent) (and ,parent (error "No such coloring type: ~S" ,parent))))) (setf (find-coloring-type ,name) (make-instance 'coloring-type :fancy-name ',fancy-name :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) :default-mode (or ',default-mode (if ,parent-type (coloring-type-default-mode ,parent-type))) ,@(if autodetect `(:autodetect-function ,autodetect)) :parent-type ,parent-type :visible (not ,invisible) :formatter-initial-values (lambda nil (list* ,@(mapcar #'(lambda (e) `(cons ',(car e) ,(second e))) formatter-variables) (if ,parent-type (funcall (coloring-type-formatter-initial-values ,parent-type)) nil))) :formatter-after-hook (lambda nil (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (concatenate 'string (funcall ,formatter-after-hook) (if ,parent-type (funcall (coloring-type-formatter-after-hook ,parent-type)) "")))) :term-formatter (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (lambda (,term) (labels ((call-parent-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (if ,parent-type (funcall (coloring-type-term-formatter ,parent-type) (cons ,type ,string)))) (call-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (funcall (case (first ,type) ,@formatters (t (lambda (,type text) (call-parent-formatter ,type text)))) ,type ,string))) (call-formatter)))) :transition-functions (list ,@(loop for transition in transitions collect (destructuring-bind (mode &rest table) transition `(cons ',mode (lambda (,current-mode ,string ,position) (let ((,mode-wait (constantly nil)) (,position-foobage ,position)) (with-scanning-functions ,string ,position-foobage ,current-mode ,mode-wait (let ((*reset-position* ,position)) (cond ,@table)) (values ,position-foobage ,current-mode (lambda (,new-position) (setf ,position-foobage ,new-position) (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) (values ,position-foobage ,advance))))) ))))))))))

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

(let ((parent-type (gensym #A((11) base-char . "PARENT-TYPE"))) (term (gensym #A((4) base-char . "TERM"))) (type (gensym #A((4) base-char . "TYPE"))) (string (gensym #A((6) base-char . "STRING"))) (current-mode (gensym #A((12) base-char . "CURRENT-MODE"))) (position (gensym #A((8) base-char . "POSITION"))) (position-foobage (gensym #A((16) base-char . "POSITION-FOOBAGE"))) (mode-wait (gensym #A((9) base-char . "MODE-WAIT"))) (new-position (gensym #A((12) base-char . "NEW-POSITION"))) (advance (gensym #A((7) base-char . "ADVANCE")))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr parent-type :kind 0) (or (find-coloring-type #S(sb-impl::comma :expr parent :kind 0)) (and #S(sb-impl::comma :expr parent :kind 0) (error "No such coloring type: ~S" #S(sb-impl::comma :expr parent :kind 0)))))) (setf (find-coloring-type #S(sb-impl::comma :expr name :kind 0)) (make-instance (quote coloring-type) :fancy-name (quote #S(sb-impl::comma :expr fancy-name :kind 0)) :modes (append (quote #S(sb-impl::comma :expr modes :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-modes #S(sb-impl::comma :expr parent-type :kind 0)))) :default-mode (or (quote #S(sb-impl::comma :expr default-mode :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-default-mode #S(sb-impl::comma :expr parent-type :kind 0)))) #S(sb-impl::comma :expr (if autodetect (sb-int:quasiquote (:autodetect-function #S(sb-impl::comma :expr autodetect :kind 0)))) :kind 2) :parent-type #S(sb-impl::comma :expr parent-type :kind 0) :visible (not #S(sb-impl::comma :expr invisible :kind 0)) :formatter-initial-values (lambda nil (list* #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr (car e) :kind 0)) #S(sb-impl::comma :expr (second e) :kind 0))))) formatter-variables) :kind 2) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-initial-values #S(sb-impl::comma :expr parent-type :kind 0))) nil))) :formatter-after-hook (lambda nil (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (concatenate (quote string) (funcall #S(sb-impl::comma :expr formatter-after-hook :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-after-hook #S(sb-impl::comma :expr parent-type :kind 0))) "")))) :term-formatter (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (lambda (#S(sb-impl::comma :expr term :kind 0)) (labels ((call-parent-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-term-formatter #S(sb-impl::comma :expr parent-type :kind 0)) (cons #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0))))) (call-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (funcall (case (first #S(sb-impl::comma :expr type :kind 0)) #S(sb-impl::comma :expr formatters :kind 2) (t (lambda (#S(sb-impl::comma :expr type :kind 0) text) (call-parent-formatter #S(sb-impl::comma :expr type :kind 0) text)))) #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0)))) (call-formatter)))) :transition-functions (list #S(sb-impl::comma :expr (loop for transition in transitions collect (destructuring-bind (mode &rest table) transition (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr mode :kind 0)) (lambda (#S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position :kind 0)) (let ((#S(sb-impl::comma :expr mode-wait :kind 0) (constantly nil)) (#S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr position :kind 0))) (with-scanning-functions #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr mode-wait :kind 0) (let ((*reset-position* #S(sb-impl::comma :expr position :kind 0))) (cond #S(sb-impl::comma :expr table :kind 2))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) (lambda (#S(sb-impl::comma :expr new-position :kind 0)) (setf #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr new-position :kind 0)) (let ((#S(sb-impl::comma :expr advance :kind 0) (nth-value 1 (funcall #S(sb-impl::comma :expr mode-wait :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0))))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr advance :kind 0)))))))))))) :kind 2)))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defannotation ignore* (vars) (:alias ignore :inline t) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars 'ignore))

Problem: Macro call that should be transformed by defannotation

Input: (defannotation ignore* (vars) (:alias ignore :inline t) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars 'ignore))

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

(progn (set-annotation-options (quote ignore*) (quote (:alias ignore :inline t))) (defmacro ignore* (vars) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars (quote ignore))))


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

Problem: Macro call that should be transformed by DRELETF*

Input:
(dreletf* nil
  nil)

Output: (defmacro DRELETF* ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error "Too much choices in branch: ~S." parse-tree)

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

Input: (signal-syntax-error "Too much choices in branch: ~S." parse-tree)

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

(signal-syntax-error* nil "Too much choices in branch: ~S." parse-tree)


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

Problem: Macro call that should be transformed by Ψ

Input: (ψ nil nil)

Output: (defmacro Ψ ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-yield (dolist (x data) (yield x)))

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

Input: (with-yield (dolist (x data) (yield x)))

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ensure-getf options :special special)

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

Input: (ensure-getf options :special special)

Output:
(defmacro ensure-getf (place key &optional default)
  (once-only (key default)
    `(setf (getf ,place ,key) (getf ,place ,key ,default))))

(let ((#:key177 :special) (#:default178 special)) (setf (getf options #:key177) (getf options #:key177 #:default178)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(sif (car x) (setf it :oops) (setf it :yes!))

Issue: Macro call that should be transformed by sif

Input: (sif (car x) (setf it :oops) (setf it :yes!))

Output:
(defmacro sif (test then &optional else)
  "Like IF, except binds the test form to IT (via SYMBOL-MACROLET) for
the scope of the then and else expressions. IT can be set with SETF"
  `(symbolic if ,test ,then ,else))

(symbolic if (car x) (setf it :oops) (setf it :yes!))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(draw scene (:rect :x 75 :y 75 :height 30 :width 30) :fill "purple")

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

Input: (draw scene (:rect :x 75 :y 75 :height 30 :width 30) :fill "purple")

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 ((#:g144 (funcall (function make-svg-element) :rect (append (list :x 75 :y 75 :height 30 :width 30) (list :fill "purple"))))) (add-element scene #:g144) #:g144)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(without-dependency-capture
  nil
  nil)

What needs to change: Macro call that should be transformed by WITHOUT-DEPENDENCY-CAPTURE

Input:
(without-dependency-capture
  nil
  nil)

Output: (defmacro WITHOUT-DEPENDENCY-CAPTURE ...)


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

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

Input:
(list-of nil
  :key
  nil)

Output: (defmacro LIST-OF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-sequences! ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))

Problem: Macro call that should be transformed by do-sequences!

Input: (do-sequences! ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))

Output:
(defmacro do-sequences! (name/seqs &body forms &environment env)
  "Mutable version of DO-SEQUENCES.

   This is the same as DO-SEQUENCES however each NAME, is the name of
   a symbol-macro, that is introduced, which expands to the 'place',
   suitable for use with SETF, of the current sequence element, rather
   than a variable storing its value. This allows the elements of the
   sequence to be mutated.

   NOTE: This macro does not support destructuring of the sequence
   elements."

  (let-if ((name name/seqs)
           (seqs (first forms) name/seqs)
           (forms (rest forms) forms))
      (symbolp name/seqs)

    (let ((safety (cadr (assoc 'safety (declaration-information 'optimize env)))))
      `(,(if (> safety 2)
             'do-sequences!-safe%
             'do-sequences!-fast%)

         ,name
         ,seqs
         ,@forms))))

(do-sequences!-fast% nil ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(alist-bind (type width) form `(,@(parse-type type (aval :tag type)) :bitfield-p t :bit-width ,width))

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

Input: (alist-bind (type width) form `(,@(parse-type type (aval :tag type)) :bitfield-p t :bit-width ,width))

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

(let ((#:alist237 form)) (let ((type (aval :type #:alist237)) (width (aval :width #:alist237))) (sb-int:quasiquote (#S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2) :bitfield-p t :bit-width #S(sb-impl::comma :expr width :kind 0)))))


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

Issue: Macro call that should be transformed by INCF

Input: (incf nil (progn))

Output: (defmacro INCF ...)


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

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

Input: (defsynonym in :in)

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(unwind-protect-case () (random 10) (:normal (push :normal result)) (:abort (push :abort result)) (:always (push :always result)))

Write a macro that addresses: Macro call that should be transformed by unwind-protect-case

Input: (unwind-protect-case () (random 10) (:normal (push :normal result)) (:abort (push :abort result)) (:always (push :always result)))

Output:
(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
the cleanup CLAUSES are run.

  clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*

Clauses can be given in any order, and more than one clause can be
given for each circumstance. The clauses whose denoted circumstance
occured, are executed in the order the clauses appear.

ABORT-FLAG is the name of a variable that will be bound to T in
CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
otherwise.

Examples:

  (unwind-protect-case ()
       (protected-form)
     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
     (:always (format t \"This is evaluated in either case.~%\")))

  (unwind-protect-case (aborted-p)
       (protected-form)
     (:always (perform-cleanup-if aborted-p)))
"
  (check-type abort-flag (or null symbol))
  (let ((gflag (gensym "FLAG+")))
    `(let ((,gflag t))
       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
	 (let ,(and abort-flag `((,abort-flag ,gflag)))
	   ,@(loop for (cleanup-kind . forms) in clauses
		   collect (ecase cleanup-kind
			     (:normal `(when (not ,gflag) ,@forms))
			     (:abort  `(when ,gflag ,@forms))
			     (:always `(progn ,@forms)))))))))

(let ((#:flag+123 t)) (unwind-protect (multiple-value-prog1 (random 10) (setf #:flag+123 nil)) (let nil (when (not #:flag+123) (push :normal result)) (when #:flag+123 (push :abort result)) (progn (push :always result)))))


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

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

Input: (-<> 'some-name)

Output: (defmacro -<> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(form &key key &aux (result NIL))

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

Input: (form &key key &aux (result NIL))

Output:
(defmacro for (&environment env bindings &body body)
  (let ((*environment* env))
    (multiple-value-bind (bind-init bind-forms bind-exit bind-post) (convert-bindings bindings)
      (multiple-value-bind (clause-init body-forms clause-exit) (convert-clauses body)
        `(with-interleaving
           ,@bind-init
           ,@clause-init
           (with-for-block ()
             (with-for-tagbody
                 (progn ,@bind-forms
                        ,@body-forms
                        ,@bind-post)
               (return-for
                ,@clause-exit
                ,@bind-exit))))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(yield-all generator)

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

Input: (yield-all generator)

Output:
(defmacro yield-all (generator)
  "Walks through generator, re-yielding all of the items in it. Only meant for use inside of a defgenerator or with-yield block."
  (let ((x (gensym)))
    `(do-generator (,x ,generator)
       (yield ,x))))

(do-generator (#:g183 generator) (yield #:g183))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(lret* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)

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

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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(in-compile-time nil
  (progn))

Problem: Macro call that should be transformed by IN-COMPILE-TIME

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

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

(macrolet ((#:macro143 (&environment ())
             (progn)))
  (#:macro143))


Instruction:
Generate a defmacro form that transforms code like this:
(with-output-to-file (file-stream pathname :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))

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

Input: (with-output-to-file (file-stream pathname :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))

Output:
(defmacro with-output-to-file ((stream-name file-name &rest args
                                            &key (direction nil direction-p)
                                            &allow-other-keys)
			       &body body)
  "Evaluate BODY with STREAM-NAME to an output stream on the file
FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
which is only sent to WITH-OPEN-FILE when it's not NIL."
  (declare (ignore direction))
  (when direction-p
    (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
  `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
     ,@body))

(with-open-file* (file-stream pathname :direction :output :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))


Instruction:
Generate a defmacro form that transforms code like this:
(>> (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))

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

Input: (>> (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))

Output:
(defmacro >> (&rest flow)
  "See flow:serially"
  `(serially ,@flow))

(serially (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(>> (-> :p () 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (mt:open-latch latch)))

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

Input: (>> (-> :p () 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (mt:open-latch latch)))

Output:
(defmacro >> (&rest flow)
  "See flow:serially"
  `(serially ,@flow))

(serially (-> :p nil 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (cl-muth:open-latch latch)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-op (:a> infix-op :sql-op-name "@>"))

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

Input: (define-op (:a> infix-op :sql-op-name "@>"))

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 (a>-op (:include infix-op (name "@>")) (:constructor make-a>-op (left right))))


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

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

Input:
(lambda-coro
  nil
  :key
  nil)

Output: (defmacro LAMBDA-CORO ...)

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


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

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

Input: (some->> nil)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(signal-syntax-error "Illegal back-reference: ~S." parse-tree)

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

Input: (signal-syntax-error "Illegal back-reference: ~S." parse-tree)

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

(signal-syntax-error* nil "Illegal back-reference: ~S." parse-tree)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(mvlet* ((left-cases right-cases (halves cases)) (split (caar right-cases))) `(if (< ,keyform ,split) ,(rec keyform left-cases) ,(rec keyform right-cases)))

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

Input: (mvlet* ((left-cases right-cases (halves cases)) (split (caar right-cases))) `(if (< ,keyform ,split) ,(rec keyform left-cases) ,(rec keyform right-cases)))

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

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

    (var var*... expr)

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

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

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

(multiple-value-bind (left-cases right-cases) (halves cases) (mvlet* ((split (caar right-cases))) (sb-int:quasiquote (if (< #S(sb-impl::comma :expr keyform :kind 0) #S(sb-impl::comma :expr split :kind 0)) #S(sb-impl::comma :expr (rec keyform left-cases) :kind 0) #S(sb-impl::comma :expr (rec keyform right-cases) :kind 0)))))


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

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

Input: (-<> nil)

Output: (defmacro -<> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(flow-lambda-macro (flow-context) (let ((fu-body `((flet ((continue-flow (&optional ,continue-arg) (capture-flow-value ,flow-context ,continue-arg) (dispatch-rest ,flow-context)) (interrupt-flow (&optional ,condi) (error ,condi))) (declare (ignorable (function continue-flow) (function interrupt-flow))) ,@body)))) (with-flow-function-macro (body-fu lambda-list fu-body) `(dispatch-asynchronously ,flow-context #',body-fu))))

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

Input: (flow-lambda-macro (flow-context) (let ((fu-body `((flet ((continue-flow (&optional ,continue-arg) (capture-flow-value ,flow-context ,continue-arg) (dispatch-rest ,flow-context)) (interrupt-flow (&optional ,condi) (error ,condi))) (declare (ignorable (function continue-flow) (function interrupt-flow))) ,@body)))) (with-flow-function-macro (body-fu lambda-list fu-body) `(dispatch-asynchronously ,flow-context #',body-fu))))

Output:
(defmacro flow-lambda-macro ((flow-context) &body body)
  `(with-gensyms (,flow-context)
     `(%flow-lambda (,,flow-context)
        ,,@body)))

(with-gensyms (flow-context) (sb-int:quasiquote (%flow-lambda (#S(sb-impl::comma :expr flow-context :kind 0)) #S(sb-impl::comma :expr (let ((fu-body (sb-int:quasiquote ((flet ((continue-flow (&optional #S(sb-impl::comma :expr continue-arg :kind 0)) (capture-flow-value #S(sb-impl::comma :expr flow-context :kind 0) #S(sb-impl::comma :expr continue-arg :kind 0)) (dispatch-rest #S(sb-impl::comma :expr flow-context :kind 0))) (interrupt-flow (&optional #S(sb-impl::comma :expr condi :kind 0)) (error #S(sb-impl::comma :expr condi :kind 0)))) (declare (ignorable (function continue-flow) (function interrupt-flow))) #S(sb-impl::comma :expr body :kind 2)))))) (with-flow-function-macro (body-fu lambda-list fu-body) (sb-int:quasiquote (dispatch-asynchronously #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr body-fu :kind 0)))))) :kind 0))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-dispatch dispatch-for-+ (args specific-hooks) (reduce #'+ (mapcar (lambda (f) (apply f args)) specific-hooks)))

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

Input: (define-dispatch dispatch-for-+ (args specific-hooks) (reduce #'+ (mapcar (lambda (f) (apply f args)) specific-hooks)))

Output:
(defmacro define-dispatch (name lambda-list &body body)
  "the lambda list should accept two arguments:
the list of arguments given by the current method call.
the specific hooks (as named or unamed functions) for the qualified method (that we will be dispatching from).

you should then use the arguments to dispatch the specific hooks as you wish in the body.
if the body returns a result, by default the method will also return that result, this can be overriden with finalize-dispatch-method.

See finalize-dispatch-method
See dispatch"
  `(let ((new-dispatch (make-dispatcher (lambda ,lambda-list ,@body))))
     (setf (gethash ',name *dispatch-table*)
           new-dispatch)))

(let ((new-dispatch (make-dispatcher (lambda (args specific-hooks) (reduce (function +) (mapcar (lambda (f) (apply f args)) specific-hooks)))))) (setf (gethash (quote dispatch-for-+) *dispatch-table*) new-dispatch))


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

Problem: Macro call that should be transformed by WITH-READER-CASE

Input:
(with-reader-case nil
  :key
  nil)

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

(let ()
  (let ((#:previous-case181 (readtable-case *readtable*)))
    (setf (readtable-case *readtable*) nil)
    (unwind-protect (progn :key nil)
      (setf (readtable-case *readtable*) #:previous-case181))))


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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(draw scene (:use :xlink-href (xlink-href columns)) :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*))

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

Input: (draw scene (:use :xlink-href (xlink-href columns)) :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*))

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 ((#:g148 (funcall (function make-svg-element) :use (append (list :xlink-href (xlink-href columns)) (list :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*)))))) (add-element scene #:g148) #:g148)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(quasiquote-expand-1 'list (append (butlast x) (mapcar 'kwote (and last (single-arg (car last))))))

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

Input: (quasiquote-expand-1 'list (append (butlast x) (mapcar 'kwote (and last (single-arg (car last))))))

Output: (defmacro quasiquote (x) (quasiquote-expand x))

(quasiquote-expand-1 (quote list) (append (butlast x) (mapcar (quote kwote) (and last (single-arg (car last))))))


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

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(define-value-binding repeating ((var 0) limit) (declare (type (integer 0) var limit)) `(when (< ,limit (incf ,var)) (end-for)))

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

Input: (define-value-binding repeating ((var 0) limit) (declare (type (integer 0) var limit)) `(when (< ,limit (incf ,var)) (end-for)))

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

(define-direct-binding repeating (var limit) (let ((#:limit178 (gensym #A((5) base-char . "LIMIT")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:limit178 limit) (loop for #:var177 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var177 0))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:limit178 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (integer 0)) :kind 0) #S(sb-impl::comma :expr var :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (integer 0)) :kind 0) #S(sb-impl::comma :expr #:limit178 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((limit #:limit178)) (declare (ignorable limit)) (sb-int:quasiquote (when (< #S(sb-impl::comma :expr limit :kind 0) (incf #S(sb-impl::comma :expr var :kind 0))) (end-for)))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-simple-documentation-lookup compiler-macro cl:compiler-macro)

Problem: Macro call that should be transformed by define-simple-documentation-lookup

Input: (define-simple-documentation-lookup compiler-macro cl:compiler-macro)

Output:
(defmacro define-simple-documentation-lookup (class documentation-type)
  `(defmethod documentation ((,class ,class))
     ,(if (eql documentation-type T)
          `(cl:documentation (object ,class) 'T)
          `(cl:documentation (designator ,class) ',documentation-type))))

(defmethod documentation ((compiler-macro compiler-macro)) (common-lisp:documentation (designator compiler-macro) (quote common-lisp:compiler-macro)))


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

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

Input: (inext nil)

Output: (defmacro INEXT ...)

(let ((vals (multiple-value-list (funcall (i-coro nil) nil))))
  (if (not vals)
      (coexit!)
      (car vals)))


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

Issue: Macro call that should be transformed by PS-PACKAGE-PREFIX

Input: (ps-package-prefix 'some-name)

Output: (defmacro PS-PACKAGE-PREFIX ...)

(gethash (find-package 'some-name) *package-prefix-table*)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(builder (:session :store (make-redis-store :namespace *namespace* :connection *connection*)) (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session))))))))

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

Input: (builder (:session :store (make-redis-store :namespace *namespace* :connection *connection*)) (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session))))))))

Output:
(defmacro builder (&rest app-or-middlewares)
  (let ((middlewares (butlast app-or-middlewares)))
    `(reduce #'funcall
             (remove-if
              #'null
              (list
               ,@(loop for mw in middlewares
                       when mw
                         collect (convert-to-middleware-form mw))))
             :initial-value (to-app ,(car (last app-or-middlewares)))
             :from-end t)))

(reduce (function funcall) (remove-if (function null) (list (lambda (#:app238) (funcall (find-middleware :session) #:app238 :store (make-redis-store :namespace *namespace* :connection *connection*))))) :initial-value (to-app (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) (sb-int:quasiquote (200 (:content-type "text/plain") (#S(sb-impl::comma :expr (format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session)))) :kind 0)))))) :from-end t)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error "No choices in branch: ~S." parse-tree)

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

Input: (signal-syntax-error "No choices in branch: ~S." parse-tree)

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

(signal-syntax-error* nil "No choices in branch: ~S." parse-tree)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(-> :g (value) (put value) (error 'skipping-condition))

Problem: Macro call that should be transformed by ->

Input: (-> :g (value) (put value) (error 'skipping-condition))

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

(atomically :g (value) (put value) (error (quote skipping-condition)))


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

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

Input: (as-> nil :key nil)

Output: (defmacro AS-> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(make-float-converters encode-float32 decode-float32 8 23 nil)

Issue: Macro call that should be transformed by make-float-converters

Input: (make-float-converters encode-float32 decode-float32 8 23 nil)

Output:
(defmacro make-float-converters (encoder-name
                                 decoder-name
                                 exponent-bits
                                 significand-bits
                                 support-nan-and-infinity-p)
  "Writes an encoder and decoder function for floating point
numbers with the given amount of exponent and significand
bits (plus an extra sign bit). If support-nan-and-infinity-p is
true, the decoders will also understand these special cases. NaN
is represented as :not-a-number, and the infinities as
:positive-infinity and :negative-infinity. Note that this means
that the in- or output of these functions is not just floating
point numbers anymore, but also keywords."
  (let* ((total-bits (+ 1 exponent-bits significand-bits))
         (exponent-offset (1- (expt 2 (1- exponent-bits)))) ; (A)
         (sign-part `(ldb (byte 1 ,(1- total-bits)) bits))
         (exponent-part `(ldb (byte ,exponent-bits ,significand-bits) bits))
         (significand-part `(ldb (byte ,significand-bits 0) bits))
         (nan support-nan-and-infinity-p)
         (max-exponent (1- (expt 2 exponent-bits)))) ; (B)
    `(progn
       (defun ,encoder-name (float)
         ,@(unless nan `((declare (type float float))))
         (multiple-value-bind (sign significand exponent)
             (cond ,@(when nan `(((eq float :not-a-number)
                                  (values 0 1 ,max-exponent))
                                 ((eq float :positive-infinity)
                                  (values 0 0 ,max-exponent))
                                 ((eq float :negative-infinity)
                                  (values 1 0 ,max-exponent))))
                   ((zerop float)
                    (values 0 0 0))
                   (t
                    (multiple-value-bind (significand exponent sign)
                        (decode-float float)
                      (let ((exponent (+ (1- exponent) ,exponent-offset))
                            (sign (if (= sign 1.0) 0 1)))
                        (unless (< exponent ,(expt 2 exponent-bits))
                          (error "Floating point overflow when encoding ~A."
                                 float))
                        (if (< exponent 0) ; (C)
                            (values sign (ash (round (* ,(expt 2 significand-bits)
                                                        significand))
                                              exponent)
                                    0)
                            (values sign (round (* ,(expt 2 significand-bits)
                                                   (1- (* significand 2))))
                                    exponent))))))
           (let ((bits 0))
             (declare (type (unsigned-byte ,total-bits) bits))
             (setf ,sign-part sign
                   ,exponent-part exponent
                   ,significand-part significand)
             bits)))

       (defun ,decoder-name (bits)
         (declare (type (unsigned-byte ,total-bits) bits))
         (let* ((sign ,sign-part)
                (exponent ,exponent-part)
                (significand ,significand-part))
           ,@(when nan `((when (= exponent ,max-exponent)
                           (return-from ,decoder-name
                             (cond ((not (zerop significand)) :not-a-number)
                                   ((zerop sign) :positive-infinity)
                                   (t :negative-infinity))))))
           (if (zerop exponent) ; (D)
               (setf exponent 1)
               (setf (ldb (byte 1 ,significand-bits) significand) 1))
           (unless (zerop sign)
             (setf significand (- significand)))
           (scale-float (float significand ,(if (> total-bits 32) 1.0d0 1.0))
                        (- exponent ,(+ exponent-offset significand-bits))))))))

(progn (defun encode-float32 (float) (declare (type float float)) (multiple-value-bind (sign significand exponent) (cond ((zerop float) (values 0 0 0)) (t (multiple-value-bind (significand exponent sign) (decode-float float) (let ((exponent (+ (1- exponent) 127)) (sign (if (= sign 1.0) 0 1))) (unless (< exponent 256) (error "Floating point overflow when encoding ~A." float)) (if (< exponent 0) (values sign (ash (round (* 8388608 significand)) exponent) 0) (values sign (round (* 8388608 (1- (* significand 2)))) exponent)))))) (let ((bits 0)) (declare (type (unsigned-byte 32) bits)) (setf (ldb (byte 1 31) bits) sign (ldb (byte 8 23) bits) exponent (ldb (byte 23 0) bits) significand) bits))) (defun decode-float32 (bits) (declare (type (unsigned-byte 32) bits)) (let* ((sign (ldb (byte 1 31) bits)) (exponent (ldb (byte 8 23) bits)) (significand (ldb (byte 23 0) bits))) (if (zerop exponent) (setf exponent 1) (setf (ldb (byte 1 23) significand) 1)) (unless (zerop sign) (setf significand (- significand))) (scale-float (float significand 1.0) (- exponent 150)))))


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

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

Input:
(iterate
  nil
  :key
  nil)

Output: (defmacro ITERATE ...)


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

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

Input: (do-notation bind-maybe ((sum (inc-maybe 1)) (str (maybe->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-maybe (lambda (sum) (bind-maybe (lambda (str) str) (maybe->string sum))) (inc-maybe 1)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(c-assert (listp (kid-values self)))

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

Input: (c-assert (listp (kid-values self)))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-condition deprecation-warning (style-warning) ((name :initarg :name :reader deprecated-name) (replacements :initarg :replacement :reader deprecated-name-replacement) (since :initarg :since :reader deprecated-since)) (:report (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))))

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

Input: (define-condition deprecation-warning (style-warning) ((name :initarg :name :reader deprecated-name) (replacements :initarg :replacement :reader deprecated-name-replacement) (since :initarg :since :reader deprecated-since)) (:report (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))))

Output:
(defmacro define (name template)
  "Define a named renderer of string TEMPLATE."
  `(setf (symbol-function ',name)
         (compile-template ,template)))

(progn (sb-kernel::%define-condition (quote deprecation-warning) (quote (style-warning)) (sb-kernel::find-condition-layout (quote deprecation-warning) (quote (style-warning))) (list (sb-kernel::make-condition-slot :name (quote name) :initargs (quote (:name)) :readers (quote (deprecated-name)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance)) (sb-kernel::make-condition-slot :name (quote replacements) :initargs (quote (:replacement)) :readers (quote (deprecated-name-replacement)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance)) (sb-kernel::make-condition-slot :name (quote since) :initargs (quote (:since)) :readers (quote (deprecated-since)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance))) (list) (quote (deprecated-since deprecated-name-replacement deprecated-name)) (quote nil) (sb-c:source-location)) (sb-kernel::%set-condition-report (quote deprecation-warning) (function (sb-int:named-lambda (sb-kernel::condition-report deprecation-warning) (condition stream) (declare (type condition condition) (type stream stream)) (funcall (function (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))) condition stream)))) (quote deprecation-warning))


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

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

Input: (*let nil)

Output: (defmacro *LET ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(lret* ((type `(integer ,start (,end))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))

Issue: Macro call that should be transformed by lret

Input: (lret* ((type `(integer ,start (,end))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))

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* ((type (sb-int:quasiquote (integer #S(sb-impl::comma :expr start :kind 0) (#S(sb-impl::comma :expr end :kind 0))))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "57P01" admin-shutdown server-shutdown)

Issue: Macro call that should be transformed by deferror

Input: (deferror "57P01" admin-shutdown server-shutdown)

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

(progn (define-condition admin-shutdown (server-shutdown) nil) (setf (gethash "57P01" *error-table*) (quote admin-shutdown)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (some #'test-failure-p results))

Issue: Macro call that should be transformed by is

Input: (is (some #'test-failure-p results))

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

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

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

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

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

(let ((#:e232 (function test-failure-p)) (#:a233 results)) (if (progn (some #:e232 #:a233)) (add-result (quote test-passed) :test-expr (quote (some (function test-failure-p) results))) (process-failure (quote (some (function test-failure-p) results)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote results) #:a233 (quote some) #:e232)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do-subclasses (ctype content) (publish ctype))

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

Input: (do-subclasses (ctype content) (publish ctype))

Output:
(defmacro do-subclasses ((var class) &body body)
  "Iterate over the subclasses of CLASS performing BODY with VAR
lexically bound to the current subclass."
  (alexandria:with-gensyms (klasses)
    `(let ((,klasses (all-subclasses (find-class ',class))))
       (loop for ,var in ,klasses do ,@body))))

(let ((#:klasses285 (all-subclasses (find-class (quote content))))) (loop for ctype in #:klasses285 do (publish ctype)))


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator (g list-or-gen) (yield g) (push g accum))

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

Input: (do-generator (g list-or-gen) (yield g) (push g accum))

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

(let ((#:g156 list-or-gen)) (loop do (if-generator ((g) #:g156) (progn (yield g) (push g accum)) (return))))


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

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

Input: (enable-reader-syntax)

Output: (defmacro ENABLE-READER-SYNTAX ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (push *readtable* *previous-readtables*)
  (setq *readtable* (copy-readtable))
  (%enable-reader-syntax *readtable*))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(*> +period+ +digit-chunks+)

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

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

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

(lambda (#:*>-offset245) (multiple-value-bind (#:*>-res246 #:*>-next247) (funcall +period+ #:*>-offset245) (if (ok? #:*>-res246) (funcall +digit-chunks+ #:*>-next247) (fail #:*>-next247))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-cache ("none" :store storage) (error "SHOULD BE ERROR"))

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

Input: (with-cache ("none" :store storage) (error "SHOULD BE ERROR"))

Output:
(defmacro with-cache ((key &key store expire) &body body)
  "If a cache indicated by KEY exists, this just returns the cache
value without evaluating BODY. Otherwise, this evaluates BODY and
stores the evaluated value into STORE with KEY and EXPIRE. KEY is a
form that an evaluated value indicates the cache key.

Example:

    (defun f (x)
      (with-cache (x *store*)
        (very-complex-computation x)))"
  (once-only (key store expire)
    (with-gensyms (value exists-p)
      `(multiple-value-bind (,value ,exists-p)
           (getcache ,key ,store)
         (if ,exists-p
             ,value
             (let ((,value (progn ,@body)))
               (setcache ,key ,value ,store :expire ,expire)
               ,value))))))

(let ((#:key242 "none") (#:store243 storage) (#:expire244 nil)) (multiple-value-bind (#:value245 #:exists-p246) (getcache #:key242 #:store243) (if #:exists-p246 #:value245 (let ((#:value245 (progn (error "SHOULD BE ERROR")))) (setcache #:key242 #:value245 #:store243 :expire #:expire244) #:value245))))


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

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

Input: (incf nil nil)

Output: (defmacro INCF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-cache ((list x y z)) (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y))))

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

Input: (with-cache ((list x y z)) (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y))))

Output:
(defmacro with-cache ((key &key store expire) &body body)
  "If a cache indicated by KEY exists, this just returns the cache
value without evaluating BODY. Otherwise, this evaluates BODY and
stores the evaluated value into STORE with KEY and EXPIRE. KEY is a
form that an evaluated value indicates the cache key.

Example:

    (defun f (x)
      (with-cache (x *store*)
        (very-complex-computation x)))"
  (once-only (key store expire)
    (with-gensyms (value exists-p)
      `(multiple-value-bind (,value ,exists-p)
           (getcache ,key ,store)
         (if ,exists-p
             ,value
             (let ((,value (progn ,@body)))
               (setcache ,key ,value ,store :expire ,expire)
               ,value))))))

(let ((#:key227 (list x y z)) (#:store228 nil) (#:expire229 nil)) (multiple-value-bind (#:value230 #:exists-p231) (getcache #:key227 #:store228) (if #:exists-p231 #:value230 (let ((#:value230 (progn (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y)))))) (setcache #:key227 #:value230 #:store228 :expire #:expire229) #:value230))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(signal-syntax-error "Unknown flag token ~A." token)

What needs to change: Macro call that should be transformed by signal-syntax-error

Input: (signal-syntax-error "Unknown flag token ~A." token)

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

(signal-syntax-error* nil "Unknown flag token ~A." token)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-iter iterator-chain-from-iter (curr-iter itail) (chain-from-iter (iterable-of-iterables) "Yields the elements of the first iterable in `iterable`, then the second, etc. Equivalent to python's chain.from_iterable(), and conceptually equivalent to `(picl:apply #'picl:chain iterable-of-iterables)`. ``` (chain-from-iter (picl:map (lambda (x) (picl:range x))) (picl:count)) ;; 0, 0, 1, 0, 1, 2, 0, 1, 2, 3, etc ```" (let ((iterable-of-iterables (make-iterator iterable-of-iterables))) (multiple-value-bind (curr-iter its-alive) (next iterable-of-iterables) (if its-alive (init-state (curr-iter (make-iterator curr-iter)) (itail iterable-of-iterables)) (empty-iterator))))) (multiple-value-bind (curr-item curr-alive) (next curr-iter) (if curr-alive (values curr-item t) (progn (multiple-value-bind (next-iter itail-alive) (next itail) (if itail-alive (progn (setf curr-iter (make-iterator next-iter)) (self)) (values nil nil)))))))

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

Input: (def-iter iterator-chain-from-iter (curr-iter itail) (chain-from-iter (iterable-of-iterables) "Yields the elements of the first iterable in `iterable`, then the second, etc. Equivalent to python's chain.from_iterable(), and conceptually equivalent to `(picl:apply #'picl:chain iterable-of-iterables)`. ``` (chain-from-iter (picl:map (lambda (x) (picl:range x))) (picl:count)) ;; 0, 0, 1, 0, 1, 2, 0, 1, 2, 3, etc ```" (let ((iterable-of-iterables (make-iterator iterable-of-iterables))) (multiple-value-bind (curr-iter its-alive) (next iterable-of-iterables) (if its-alive (init-state (curr-iter (make-iterator curr-iter)) (itail iterable-of-iterables)) (empty-iterator))))) (multiple-value-bind (curr-item curr-alive) (next curr-iter) (if curr-alive (values curr-item t) (progn (multiple-value-bind (next-iter itail-alive) (next itail) (if itail-alive (progn (setf curr-iter (make-iterator next-iter)) (self)) (values nil nil)))))))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname135 (&key curr-iter itail) (labels ((self nil (multiple-value-bind (curr-item curr-alive) (next curr-iter) (if curr-alive (values curr-item t) (progn (multiple-value-bind (next-iter itail-alive) (next itail) (if itail-alive (progn (setf curr-iter (make-iterator next-iter)) (self)) (values nil nil)))))))) (function self)))) (defun chain-from-iter (iterable-of-iterables) "Yields the elements of the first iterable in `iterable`, then the second, etc. Equivalent to python's chain.from_iterable(), and conceptually equivalent to `(picl:apply #'picl:chain iterable-of-iterables)`. ``` (chain-from-iter (picl:map (lambda (x) (picl:range x))) (picl:count)) ;; 0, 0, 1, 0, 1, 2, 0, 1, 2, 3, etc ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname135)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (let ((iterable-of-iterables (make-iterator iterable-of-iterables))) (multiple-value-bind (curr-iter its-alive) (next iterable-of-iterables) (if its-alive (init-state (curr-iter (make-iterator curr-iter)) (itail iterable-of-iterables)) (empty-iterator)))))))


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

Problem: Macro call that should be transformed by DEFREPLY

Input:
(defreply nil
    :key
  nil)

Output: (defmacro DEFREPLY ...)

(progn
 (eval-when (:compile-toplevel)
   (unless (fboundp 'nil)
     (warn 'automatic-message-creation :message-name 'nil)
     (ensure-message 'nil :lambda-list 'nil)))
 (ensure-reply 'nil :qualifiers '(:key) :lambda-list 'nil :participants (list)
               :documentation nil :function
               (lambda (#:args144 #:next-replies145 &rest #:more-args147)
                 (declare
                  (ignorable #:args144 #:next-replies145 #:more-args147))
                 (flet ((next-reply-p ()
                          (not (null #:next-replies145)))
                        (call-next-reply (&rest args)
                          (if (null #:next-replies145)
                              (apply 'no-next-reply
                                     (getf #:more-args147 :message)
                                     (getf #:more-args147 :reply)
                                     (or args #:args144))
                              (apply (reply-function (car #:next-replies145))
                                     (or args #:args144)
                                     (cdr #:next-replies145) #:more-args147))))
                   (declare
                    (ignorable (function next-reply-p)
                     (function call-next-reply)))
                   (flet ((#:reply-function146 ()
                            (declare (ignorable))
                            (block nil)))
                     (declare (inline #:reply-function146))
                     (apply #'#:reply-function146 #:args144))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-class-method nil
    :key
  nil)

Pattern to recognize: Macro call that should be transformed by DEFINE-CLASS-METHOD

Input:
(define-class-method nil
    :key
  nil)

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

(progn
 (define-incongruent-method nil
     :key
   nil)
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (add-class-principal-method 'nil ':key)))


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

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

Input:
(as-> nil
    :key
  nil)

Output: (defmacro AS-> ...)


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

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

Input: (is-true t)

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

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


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

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

Input: (defobject 'some-name)

Output: (defmacro DEFOBJECT ...)

(object :parents (list quote some-name) :properties (list))


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

Issue: Macro call that should be transformed by ITERATE

Input: (iterate)

Output: (defmacro ITERATE ...)


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

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

Input: (defsynonym never :never)

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-simple-definition-resolver macro macro-function)

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

Input: (define-simple-definition-resolver macro macro-function)

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

(define-definition-resolver macro (macro #:package134) (when (ignore-errors (macro-function macro)) (list (make-instance (quote macro) :designator macro :package #:package134))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-option-expander shadow (package &rest symbols) (shadow symbols package))

Issue: Macro call that should be transformed by define-option-expander

Input: (define-option-expander shadow (package &rest symbols) (shadow symbols 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 ((#:type128 (eql :shadow)) package #:args127) (destructuring-bind (&rest symbols) #:args127 (shadow symbols package)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(lambda-ematch0 ((list* var options) `(type ,(getf options :type) ,var)))

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

Input: (lambda-ematch0 ((list* var options) `(type ,(getf options :type) ,var)))

Output:
(defmacro lambda-ematch0 (&body clauses)
  (alexandria:with-gensyms (arg)
    `(lambda (,arg)
       (ematch0 ,arg
         ,@clauses))))

(lambda (#:arg167) (ematch0 #:arg167 ((list* var options) (sb-int:quasiquote (type #S(sb-impl::comma :expr (getf options :type) :kind 0) #S(sb-impl::comma :expr var :kind 0))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite cdadar (expr) `(cdr (cadar ,(second expr))))

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

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


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

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

Input:
(lambda-match
  nil
  :key
  nil)

Output: (defmacro LAMBDA-MATCH ...)

(lambda (#:arg149)
  (match #:arg149
    nil
    :key
    nil))


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

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

Input: (receive (x) (values) x)

Output:
(defmacro receive (formals expr &body body)
  "Stricter version of `multiple-value-bind'.

Use `receive' when you want to enforce that EXPR should return a
certain number of values, or a minimum number of values.

If FORMALS is a proper list, then EXPR must return exactly as many
values -- no more and no less -- as there are variables in FORMALS.

If FORMALS is an improper list (VARS . REST), then EXPR must return at
least as many values as there are VARS, and any further values are
bound, as a list, to REST.

Lastly, if FORMALS is a symbol, bind that symbol to all the values
returned by EXPR, as if by `multiple-value-list'.

From Scheme (SRFI-8)."
  ;; It's probably not worth stack-allocating the thunk.
  (cond ((null formals)
         `(multiple-value-call
              (lambda ()
                ,@body)
            ,expr))
        ((atom formals)
         ;; This could also be written:
         #+(or) `(let ((,formals (multiple-value-list ,expr)))
                   ,@body)
         ;; But I want it to be possible to declare FORMALS to have
         ;; dynamic extent, and most Lisps support that for &rest
         ;; lists.
         `(multiple-value-call
              (lambda (&rest ,formals)
                ,@body)
            ,expr))
        ((proper-list-p formals)
         (when (intersection formals lambda-list-keywords)
           (error "Lambda list keywords in formals: ~a" formals))
         `(multiple-value-call
              (lambda ,formals
                ,@body)
            ,expr))
        (t (let* ((last (last formals))
                  (vars (append (butlast formals)
                                (list (car last))))
                  (rest (cdr last)))
             (when (intersection (cons rest vars) lambda-list-keywords)
               (error "Lambda list keywords in formals: ~a" formals))
             `(multiple-value-call
                  (lambda (,@vars &rest ,rest)
                    ,@body)
                ,expr)))))

(multiple-value-call (lambda (x) x) (values))


Instruction:
Define a macro that eliminates this repetitive pattern:
(do+ (for x (to 5)) (generating y (in #(0 1))) (collect (list x y)) (when (oddp x) (is (eql (try-update y :on-error (lambda (value cond) (setf error cond) value)) y))) (when error (multiple-value-bind (value success?) (try-update y) (is (eql value y)) (is (null success?)))))

Issue: Macro call that should be transformed by do+

Input: (do+ (for x (to 5)) (generating y (in #(0 1))) (collect (list x y)) (when (oddp x) (is (eql (try-update y :on-error (lambda (value cond) (setf error cond) value)) y))) (when error (multiple-value-bind (value success?) (try-update y) (is (eql value y)) (is (null success?)))))

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

(do+/internal nil (for x (to 5)) (generating y (in #(0 1))) (collect (list x y)) (when (oddp x) (is (eql (try-update y :on-error (lambda (value cond) (setf error cond) value)) y))) (when error (multiple-value-bind (value success?) (try-update y) (is (eql value y)) (is (null success?)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun list-indexes ((type :node)) :get (:uri-spec (format nil "index/~A" (string-downcase (symbol-name type)))) (:status-handlers (200 (decode-neo4j-json-output body))))

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

Input: (def-neo4j-fun list-indexes ((type :node)) :get (:uri-spec (format nil "index/~A" (string-downcase (symbol-name type)))) (:status-handlers (200 (decode-neo4j-json-output body))))

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 list-indexes (&key (type :node)) (let ((uri (format nil "index/~A" (string-downcase (symbol-name type)))) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))))))))


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

Problem: Macro call that should be transformed by DEFITER

Input:
(defiter nil
    (progn))

Output: (defmacro DEFITER ...)

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


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

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

Input:
(define-templated-dispatch nil
    :key
  nil)

Output: (defmacro DEFINE-TEMPLATED-DISPATCH ...)


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

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

Input: (caching-types)

Output: (defmacro CACHING-TYPES ...)

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


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:
Create a Common Lisp macro for the following transformation. Before code:
(->*
  nil
  (progn))

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

Input:
(->*
  nil
  (progn))

Output: (defmacro ->* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-class some-class (some super classes) ((slot1 :unbound :documentation "zork")) (1 2) (3 4))

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

Input: (define-class some-class (some super classes) ((slot1 :unbound :documentation "zork")) (1 2) (3 4))

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

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

Slot options:

- The initform can be specified as the second value.

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

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

New class options (defaults are NIL unless specified):

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(progn (defclass some-class (some super classes) ((slot1 :accessor slot1 :initarg :slot1 :documentation "zork")) (1 2) (3 4)) (unless (fboundp (quote some-class-p)) (define-generic some-class-p (object) #A((75) base-char . "Auto-generated predicate for whether OBJECT is an instance of `some-class'.") (declare (sb-ext:muffle-conditions style-warning)) (typep object (quote some-class)))) (setf (documentation (quote slot1) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot SLOT1.
zork")) (ignore-errors (setf (documentation (fdefinition (quote slot1)) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot SLOT1.
zork"))) (ignore-errors (setf (documentation (fdefinition (quote (setf slot1))) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot SLOT1.
zork"))) (find-class (quote some-class) nil))


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

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

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

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

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


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

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

Input: (defstore example (object))

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


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

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

Input: (some->)

Output: (defmacro SOME-> ...)


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

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

Input: (with-packages-unlocked 'some-name)

Output: (defmacro WITH-PACKAGES-UNLOCKED ...)

(let ((#:|packages124| (locked-packages ''some-name)))
  (unlock-packages #:|packages124|)
  (unwind-protect (lock-packages #:|packages124|)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(answer foo 42)

Problem: Macro call that should be transformed by answer

Input: (answer foo 42)

Output:
(defmacro answer (call &body forms)
  (let ((name (if (listp call) (car call) call))
        (sym (gensym)))
    `(if-called
      ',name
      (let ((,sym (fdefinition ',name)))
        (declare (ignorable ,sym))
        (let ((times 0))
          (lambda (&rest args)
            (declare (ignorable args))
            ,(let ((cases
                     `(case (prog1 times (incf times))
                        ,.(loop
                            for i from 0
                            for (form . rest) on forms
                            collect `(,(if rest i T) ,form)))))
               (if (listp call)
                   `(trivia:match args
                     ((list . ,(cdr call)) ,cases)
                     (_ (unhandled)))
                   cases))))))))

(if-called (quote foo) (let ((#:g162 (fdefinition (quote foo)))) (declare (ignorable #:g162)) (let ((times 0)) (lambda (&rest args) (declare (ignorable args)) (case (prog1 times (incf times)) (t 42))))))