Instruction:
Define a macro that eliminates this repetitive pattern:
(with-additional-indent (reporter stream "- ") (let ((description (possible-report-description report))) (when description (format/indent reporter stream description))))

Issue: Macro call that should be transformed by with-additional-indent

Input: (with-additional-indent (reporter stream "- ") (let ((description (possible-report-description report))) (when description (format/indent reporter stream description))))

Output:
(defmacro with-additional-indent ((reporter stream control-string &rest format-arguments) &body body)
  (declare (ignorable reporter stream control-string))
  (let* ((need-new-line (ppcre:scan "^~&" control-string))
         (string (apply #'format nil control-string format-arguments))
         (increment (length string)))
    `(with-slots (indent-space) reporter
       (let* ((first-line-indent (indent indent-space))
              (*additional-indent* ,(if need-new-line
                                        increment
                                        `(+ *additional-indent*
                                            ,increment))))
         (declare (ignorable first-line-indent))
         ,(if need-new-line
              `(progn (fresh-line stream)
                      (write-string first-line-indent ,stream)
                      ;; because we just started a new line, we
                      ;; should use format/indent to write string
                      ;; taking into account a main indentation level
                      (format/indent ,reporter ,stream ,string))
              ;; otherwise, just output our prefix
              `(write-string ,string ,stream))

         ,@body))))

(with-slots (indent-space) reporter (let* ((first-line-indent (indent indent-space)) (*additional-indent* (+ *additional-indent* 2))) (declare (ignorable first-line-indent)) (write-string #A((2) base-char . "- ") stream) (let ((description (possible-report-description report))) (when description (format/indent reporter stream description)))))


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

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

Input:
(define nil
  (progn))

Output: (defmacro DEFINE ...)

(eval-when (:load-toplevel :execute)
  (check-if-bound 'nil)
  (setf (get 'nil 'read-macro)
          (lambda (#:stream147)
            (let ((*standard-input* #:stream147))
              (progn))))
  'nil)


Instruction:
Generate a defmacro form that transforms code like this:
(draw scene (:rect :x 5 :y 5 :height 30 :width 30))

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

Input: (draw scene (:rect :x 5 :y 5 :height 30 :width 30))

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 ((#:g142 (funcall (function make-svg-element) :rect (append (list :x 5 :y 5 :height 30 :width 30) (list))))) (add-element scene #:g142) #:g142)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do+ (for x (across #())) (collect x))

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

Input: (do+ (for x (across #())) (collect x))

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 (across #())) (collect x))


Instruction:
Generate a defmacro form that transforms code like this:
(insert-char-class-tester (regex (schar *string* curr-pos)) (constant-repetition-constant-length-closure (and (char-class-test) (1+ curr-pos))))

Pattern to recognize: Macro call that should be transformed by insert-char-class-tester

Input: (insert-char-class-tester (regex (schar *string* curr-pos)) (constant-repetition-constant-length-closure (and (char-class-test) (1+ curr-pos))))

Output:
(defmacro insert-char-class-tester ((char-class chr-expr) &body body)
  "Utility macro to replace each occurence of '\(CHAR-CLASS-TEST)
within BODY with the correct test (corresponding to CHAR-CLASS)
against CHR-EXPR."
  (with-rebinding (char-class)
    (with-unique-names (test-function)
      (flet ((substitute-char-class-tester (new)
               (subst new '(char-class-test) body
                      :test #'equalp)))
        `(let ((,test-function (test-function ,char-class)))
           ,@(substitute-char-class-tester
              `(funcall ,test-function ,chr-expr)))))))

(let ((#:char-class161 regex)) (let ((#:test-function162 (test-function #:char-class161))) (constant-repetition-constant-length-closure (and (funcall #:test-function162 (schar *string* curr-pos)) (1+ curr-pos)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-error if-branch-type-mismatch (:error-type varjo-critical-error) (then-obj) "Type mismatch: else-case is nil which is of bool type, yet the then form is of ~s type." (type->type-spec (primary-type then-obj)))

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

Input: (define-error if-branch-type-mismatch (:error-type varjo-critical-error) (then-obj) "Type mismatch: else-case is nil which is of bool type, yet the then form is of ~s type." (type->type-spec (primary-type then-obj)))

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

(defcondition if-branch-type-mismatch (:error-type varjo-critical-error :prefix "Varjo") (then-obj) "Type mismatch: else-case is nil which is of bool type, yet the then form is of ~s type." (type->type-spec (primary-type then-obj)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-value-binding from ((var (if ascending (- from by) (+ from by))) from &key (to NIL to-p) (by 1) &aux (ascending (or (not to) (< from to)))) (declare (type real var from by) (type (or real null) to) (type boolean ascending)) (declare (ignore from)) (if to-p `(cond (,ascending (incf ,var ,by) (when (<= ,to ,var) (end-for))) (T (decf ,var ,by) (when (<= ,var ,to) (end-for)))) `(incf ,var ,by)))

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

Input: (define-value-binding from ((var (if ascending (- from by) (+ from by))) from &key (to NIL to-p) (by 1) &aux (ascending (or (not to) (< from to)))) (declare (type real var from by) (type (or real null) to) (type boolean ascending)) (declare (ignore from)) (if to-p `(cond (,ascending (incf ,var ,by) (when (<= ,to ,var) (end-for))) (T (decf ,var ,by) (when (<= ,var ,to) (end-for)))) `(incf ,var ,by)))

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 from (var from &key (to nil to-p) (by 1)) (let ((#:ascending176 (gensym #A((9) base-char . "ASCENDING"))) (#:from173 (gensym #A((4) base-char . "FROM"))) (#:to174 (gensym #A((2) base-char . "TO"))) (#:by175 (gensym #A((2) base-char . "BY")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:from173 from) (list #:to174 to) (list #:by175 by) (list #:ascending176 (list (quote or) (list (quote not) #:to174) (list (quote <) #:from173 #:to174))) (loop for #:var172 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var172 (list (quote if) #:ascending176 (list (quote -) #:from173 #:by175) (list (quote +) #:from173 #:by175))))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:ascending176 :kind 0) #S(sb-impl::comma :expr #:from173 :kind 0) #S(sb-impl::comma :expr #:to174 :kind 0) #S(sb-impl::comma :expr #:by175 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :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 real) :kind 0) #S(sb-impl::comma :expr #:from173 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :kind 0) #S(sb-impl::comma :expr #:by175 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (or real null)) :kind 0) #S(sb-impl::comma :expr #:to174 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote boolean) :kind 0) #S(sb-impl::comma :expr #:ascending176 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((ascending #:ascending176) (from #:from173) (to #:to174) (by #:by175)) (declare (ignorable ascending from to by)) (declare (ignore from)) (if to-p (sb-int:quasiquote (cond (#S(sb-impl::comma :expr ascending :kind 0) (incf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr by :kind 0)) (when (<= #S(sb-impl::comma :expr to :kind 0) #S(sb-impl::comma :expr var :kind 0)) (end-for))) (t (decf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr by :kind 0)) (when (<= #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr to :kind 0)) (end-for))))) (sb-int:quasiquote (incf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr by :kind 0))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-html-string (:div :class "last-update col-xs-2 col-md-1" :title "Last updated 232 days ago" "232d"))

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

Input: (with-html-string (:div :class "last-update col-xs-2 col-md-1" :title "Last updated 232 days ago" "232d"))

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

(with-output-to-string (*html*) (with-html (:div :class "last-update col-xs-2 col-md-1" :title "Last updated 232 days ago" "232d")))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-cfun c-free)

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

Input: (define-cfun c-free)

Output:
(defmacro define-cfun (name-or-function &optional (package *package*))
  (when-let ((fun (find-function name-or-function)))
    (with-wrap-attempt ("function ~S" name-or-function) name-or-function
      (with-slots (name type c-symbol fields) fun
        (let* ((fun-name (intern (symbol-name name) package))
               (param-names (mapcar #'foreign-type-name fields))
               (param-syms (mapcar (lambda (x) (gensym (symbol-name x))) param-names))
               (make-function-p (not (foreign-function-variadic-p fun)))
               (maybe-cbv-return
                 (when (cbv-return-p fun)
                   (list 'return-value))))
          (with-gensyms (!fun !fields rest)
            (let ((form
                    (if make-function-p
                        `(defun ,fun-name (,@maybe-cbv-return
                                           ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           ,(let ((!fun (find-function name-or-function)))
                              (with-slots ((!fields fields)) !fun
                                (foreign-to-ffi
                                 (and (car !fields) (foreign-type (car !fields)))
                                 param-syms
                                 param-names
                                 !fields
                                 (make-foreign-funcall !fun (and maybe-cbv-return 'return-value)
                                                       param-syms (when (foreign-function-variadic-p fun) rest))))))
                        `(defmacro ,fun-name (,@maybe-cbv-return
                                              ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           (let ((,!fun (find-function ',name-or-function)))
                             (with-slots ((,!fields fields)) ,!fun
                               (foreign-to-ffi
                                (and (car ,!fields) (foreign-type (car ,!fields)))
                                ',param-syms
                                (list ,@param-names)
                                ,!fields
                                (make-foreign-funcall ,!fun ,(and maybe-cbv-return 'return-value)
                                                      ',param-syms ,(when (foreign-function-variadic-p fun) rest)))))))))
              `(progn
                 ,@(when (foreign-function-cbv-p fun)
                     (list (funcall *build-libffi-definition* fun)))
                 ,form))))))))

(progn (defun c-free (ptr) (let ((#:ptr209 ptr)) (declare (ignorable #:ptr209)) (cffi-sys:%foreign-funcall "free" (:pointer #:ptr209 :void) :convention :cdecl))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclass/std foo2 () ((bar baz)))

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

Input: (defclass/std foo2 () ((bar baz)))

Output:
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

(defclass foo2 nil ((bar :accessor bar :initarg :bar :initform nil) (baz :accessor baz :initarg :baz :initform nil)))


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

Problem: Macro call that should be transformed by DECF

Input: (decf nil)

Output: (defmacro DECF ...)


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

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

Input: (collect-file nil (progn))

Output: (defmacro COLLECT-FILE ...)

(common-lisp:let* ((#:generator-551 (generator (progn)))
                   #:items-545
                   (#:out-547 t))
  (declare (type generator #:generator-551)
           (type boolean #:out-547))
  (with-open-file (#:outfile-544 nil :direction :output)
    (tagbody
     #:ll-552
      (setq #:items-545 (next-in #:generator-551 (go end)))
      (common-lisp:funcall #'print #:items-545 #:outfile-544)
      (go #:ll-552)
     end))
  #:out-547)


Instruction:
Define a macro that eliminates this repetitive pattern:
(form-fiddle:lambda-declarations `(lambda () ,@body))

Issue: Macro call that should be transformed by for

Input: (form-fiddle:lambda-declarations `(lambda () ,@body))

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

(form-fiddle:lambda-declarations (sb-int:quasiquote (lambda nil #S(sb-impl::comma :expr body :kind 2))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(builder (:session :store (make-redis-store :namespace *namespace* :connection *connection* :expires 3)) (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (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* :expires 3)) (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (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 (#:app242) (funcall (find-middleware :session) #:app242 :store (make-redis-store :namespace *namespace* :connection *connection* :expires 3))))) :initial-value (to-app (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (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, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session)))) :kind 0)))))) :from-end t)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-form-fields (name) form (print (field-value name)))

Issue: Macro call that should be transformed by with-form-fields

Input: (with-form-fields (name) form (print (field-value name)))

Output:
(defmacro with-form-fields (fields form &body body)
  "Bind FIELDS to the form fields in FORM.

Example:

@lisp
(with-form-fields (name) form
   (print (field-value name)))
@end lisp

Also see: WITH-FORM-FIELD-VALUES "
  `(let ,(loop for field in fields
               collect `(,field (get-field ,form ',field)))
     ,@body))

(let ((name (get-field form (quote name)))) (print (field-value name)))


Instruction:
Generate a defmacro form that transforms code like this:
(augment-lexenv! :variable whole-var lexenv)

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

Input: (augment-lexenv! :variable whole-var lexenv)

Output:
(defmacro augment-lexenv! (kind name env &rest other-datum)
  `(setf ,env (augment-lexenv ,kind ,name ,env ,@other-datum)))

(setf lexenv (augment-lexenv :variable whole-var lexenv))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-error setq-type-match (:error-type varjo-critical-error) (var-name old-value new-value) "Currently varjo cannot handle changing the type through a setq due to the static nature of glsl. var name: ~a type-of ~a: ~a type-of new-value: ~a" var-name var-name (v-type-of old-value) (primary-type new-value))

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

Input: (define-error setq-type-match (:error-type varjo-critical-error) (var-name old-value new-value) "Currently varjo cannot handle changing the type through a setq due to the static nature of glsl. var name: ~a type-of ~a: ~a type-of new-value: ~a" var-name var-name (v-type-of old-value) (primary-type new-value))

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

(defcondition setq-type-match (:error-type varjo-critical-error :prefix "Varjo") (var-name old-value new-value) "Currently varjo cannot handle changing the type through a setq due to the static nature of glsl. var name: ~a type-of ~a: ~a type-of new-value: ~a" var-name var-name (v-type-of old-value) (primary-type new-value))


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

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

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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-errno-symbol ERANGE)

Problem: Macro call that should be transformed by define-errno-symbol

Input: (define-errno-symbol ERANGE)

Output:
(defmacro define-errno-symbol (name)
  `(defparameter ,name
     (find-errno-symbol (string ',name))))

(defparameter erange (find-errno-symbol (string (quote erange))))


Instruction:
Generate a defmacro form that transforms code like this:
(defpattern cons (a b) (with-gensyms (it) `(guard1 (,it :type cons) (consp ,it) (car ,it) ,a (cdr ,it) ,b)))

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

Input: (defpattern cons (a b) (with-gensyms (it) `(guard1 (,it :type cons) (consp ,it) (car ,it) ,a (cdr ,it) ,b)))

Output:
(defmacro defpattern (name args &body body)
  "Adds a new derived pattern.
The default value of &optional arguments are '_, instead of nil."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (symbol-pattern ',name)
           #+sbcl
           (sb-int:named-lambda ',name ,(process-lambda-args args) ,@body)
           #-sbcl
           (lambda ,(process-lambda-args args) ,@body))
     ,@(when (stringp (first body))
         ;; lisp-namespace
         `((setf (documentation ',name 'pattern)
                 ,(let ((*print-pretty* t))
                    #-clisp
                    (format nil "~<Lambda-List: ~s~
                                 ~:@_~<  ~@;~a~:>~
                                 ~:@_Defined in ~a~
                               ~:>"
                            (list args (list (first body)) *compile-file-pathname*))
                    #+clisp
                    (format nil "Lambda-List: ~s~%~a"
                            args (first body))))))))

(%defpattern cons (quote a) (quote b) (lambda (with-gensyms (it) (quasiquote (guard1 (#S(sb-impl::comma :expr it :kind 0) :type cons) (consp #S(sb-impl::comma :expr it :kind 0)) (car #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr a :kind 0) (cdr #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr b :kind 0))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(aif (eval `(and ,(incf x) nil)) :never (list it x))

Issue: Macro call that should be transformed by aif

Input: (aif (eval `(and ,(incf x) nil)) :never (list it x))

Output:
(defmacro aif (test then &optional else)
  "Like IF, except binds the result of the test to IT (via LET) for
the scope of the then and else expressions."
  `(anaphoric if ,test ,then ,else))

(anaphoric if (eval (sb-int:quasiquote (and #S(sb-impl::comma :expr (incf x) :kind 0) nil))) :never (list it x))


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

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

Input:
(caching-types
  nil
  (progn))

Output: (defmacro CACHING-TYPES ...)

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


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

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

Input: (fnn nil nil)

Output: (defmacro FNN ...)


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

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

Input:
(cond->
  nil
  :key
  nil)

Output: (defmacro COND-> ...)


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

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

Input: (ignore-errors nil)

Output: (defmacro IGNORE-ERRORS ...)

(handler-case (progn nil) (error (condition) (values nil condition)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(~> (-> :one () (increment)) (-> :two () (increment)) (-> :three () (increment)))

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

Input: (~> (-> :one () (increment)) (-> :two () (increment)) (-> :three () (increment)))

Output:
(defmacro ~> (&rest body)
  "See flow:concurrently"
  `(concurrently ,@body))

(concurrently (-> :one nil (increment)) (-> :two nil (increment)) (-> :three nil (increment)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-error cannot-compile () (code) "Cannot compile the following code:~%~a" code)

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

Input: (define-error cannot-compile () (code) "Cannot compile the following code:~%~a" code)

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

(defcondition cannot-compile (:error-type varjo-error :prefix "Varjo") (code) "Cannot compile the following code:~%~a" code)


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

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

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

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


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

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

Input:
(gatherlet nil
  :key
  nil)

Output: (defmacro GATHERLET ...)


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

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

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

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

(defun mustache-version (&rest args) #A((31) base-char . "Return the CL-MUSTACHE version.") (warn (quote deprecation-warning) :name (quote mustache-version) :replacement (quote version) :since "0.10.0") (apply (quote version) args))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(secase (car x) (:y :no))

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

Input: (secase (car x) (:y :no))

Output:
(defmacro secase (keyform &body cases)
  "Like ECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
scope of the cases. IT can be set with SETF."
  `(symbolic ecase ,keyform ,@cases))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(do+ (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

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

Input: (do+ (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

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 (across #(1 2 3 4) :index index)) (for k (in (quote (a b c d e)))) (returning (list x k :index index)))


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

Problem: Macro call that should be transformed by WITH*

Input:
(with* nil
  :key
  nil)

Output: (defmacro WITH* ...)


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

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

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

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

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


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

Problem: Macro call that should be transformed by defreadtable

Input: (defreadtable pax:macro)

Output:
(defmacro defreadtable (name &body options)
  "Define a new named readtable, whose name is given by the symbol NAME.
  Or, if a readtable is already registered under that name, redefine
  that one.

  The readtable can be populated using the following OPTIONS:

  - If the first element of OPTIONS is a string then it is associated
    with the readtable as in `(SETF (DOCUMENTATION NAME 'READTABLE)
    DOCSTRING)`.

  - `(:MERGE READTABLE-DESIGNATORS+)`

      Merge the macro character definitions from the readtables
      designated into the new readtable being defined as per
      MERGE-READTABLES-INTO. The copied options are
      :DISPATCH-MACRO-CHAR, :MACRO-CHAR and :SYNTAX-FROM, but not
      READTABLE-CASE.

      If no :MERGE clause is given, an empty readtable is used. See
      MAKE-READTABLE.

  - `(:FUSE READTABLE-DESIGNATORS+)`

      Like :MERGE except:

      Error conditions of type READER-MACRO-CONFLICT that are signaled
      during the merge operation will be silently _continued_. It
      follows that reader macros in earlier entries will be
      overwritten by later ones. For backward compatibility, :FUZE is
      accepted as an alias of :FUSE.

  - `(:DISPATCH-MACRO-CHAR MACRO-CHAR SUB-CHAR FUNCTION)`

      Define a new sub character `SUB-CHAR` for the dispatching macro
      character `MACRO-CHAR`, per SET-DISPATCH-MACRO-CHARACTER. You
      probably have to define `MACRO-CHAR` as a dispatching macro
      character by the following option first.

  - `(:MACRO-CHAR MACRO-CHAR FUNCTION [NON-TERMINATING-P])`

      Define a new macro character in the readtable, per
      SET-MACRO-CHARACTER. If [FUNCTION][pax:argument] is the keyword
      :DISPATCH, `MACRO-CHAR` is made a dispatching macro character,
      per MAKE-DISPATCH-MACRO-CHARACTER.

  - `(:SYNTAX-FROM FROM-READTABLE-DESIGNATOR FROM-CHAR TO-CHAR)`

      Set the character syntax of TO-CHAR in the readtable being
      defined to the same syntax as FROM-CHAR as per
      SET-SYNTAX-FROM-CHAR.

  - `(:CASE CASE-MODE)`

      Defines the _case sensitivity mode_ of the resulting readtable.

  Any number of option clauses may appear. The options are grouped by
  their type, but in each group the order the options appeared
  textually is preserved. The following groups exist and are executed
  in the following order: :MERGE and :FUSE (one group), :CASE,
  :MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group), finally
  :SYNTAX-FROM.

  Notes:

  The readtable is defined at load-time. If you want to have it
  available at compilation time -- say to use its reader-macros in the
  same file as its definition -- you have to wrap the DEFREADTABLE
  form in an explicit EVAL-WHEN.

  On redefinition, the target readtable is made empty first before
  it's refilled according to the clauses.

  NIL, :STANDARD, :COMMON-LISP, :MODERN, and :CURRENT are
  preregistered readtable names."
  (check-type name symbol)
  (when (reserved-readtable-name-p name)
    (error "~A is the designator for a predefined readtable. ~
            Not acceptable as a user-specified readtable name." name))
  (flet ((process-option (option var)
           (destructure-case option
             ((:merge &rest readtable-designators)
	      `(merge-readtables-into ,var ,@(mapcar #'(lambda (x) `',x)
                                                     readtable-designators)))
             ((:fuse &rest readtable-designators)
	      `(handler-bind ((reader-macro-conflict #'continue))
                 (merge-readtables-into ,var ,@(mapcar #'(lambda (x) `',x)
                                                       readtable-designators))))
             ;; alias for :FUSE
             ((:fuze &rest readtable-designators)
	      `(handler-bind ((reader-macro-conflict #'continue))
                 (merge-readtables-into ,var ,@(mapcar #'(lambda (x) `',x)
                                                       readtable-designators))))
             ((:dispatch-macro-char disp-char sub-char function)
              `(set-dispatch-macro-character ,disp-char ,sub-char
                                             ,function ,var))
             ((:macro-char char function &optional non-terminating-p)
	      (if (eq function :dispatch)
		  `(make-dispatch-macro-character ,char ,non-terminating-p ,var)
		  `(set-macro-character ,char ,function
                                        ,non-terminating-p ,var)))
	     ((:syntax-from from-rt-designator from-char to-char)
	      `(set-syntax-from-char ,to-char ,from-char
				     ,var (find-readtable ,from-rt-designator)))
	     ((:case mode)
	      `(setf (readtable-case ,var) ,mode))))
	 (remove-clauses (clauses options)
	   (setq clauses (if (listp clauses) clauses (list clauses)))
	   (remove-if-not #'(lambda (x) (member x clauses))
			  options :key #'first)))
    (let* ((docstring (when (stringp (first options))
                        (pop options)))
           (merge-clauses (remove-clauses '(:merge :fuze :fuse) options))
	   (case-clauses (remove-clauses :case  options))
	   (macro-clauses (remove-clauses '(:macro-char :dispatch-macro-char)
                                          options))
	   (syntax-clauses (remove-clauses :syntax-from options))
	   (other-clauses
             (set-difference options
                             (append merge-clauses case-clauses
                                     macro-clauses syntax-clauses)))
           (%dummy (gensym "SOURCE-LOCATION-DUMMY")))
      (cond
	((not (null other-clauses))
	 (error "Bogus DEFREADTABLE clauses: ~/PPRINT-LINEAR/" other-clauses))
	(t
	 `(eval-when (:load-toplevel :execute)
            ;; The (FIND-READTABLE ...) is important for proper
            ;; redefinition semantics, as redefining has to modify the
            ;; already existing readtable object.
            (let ((readtable (find-readtable ',name)))
              (cond ((not readtable)
                     (setq readtable (make-readtable ',name)))
                    (t
                     (setq readtable (%clear-readtable readtable))
                     (simple-style-warn
                      "Overwriting already existing readtable ~S."
                      readtable)))
              (setf (documentation readtable 'readtable) ,docstring)
              (defun ,%dummy ())
              (%associate-dummy-with-readtable readtable ',%dummy)
              ,@(loop for option in merge-clauses
                      collect (process-option option 'readtable))
              ,@(loop for option in case-clauses
                      collect (process-option option 'readtable))
              ,@(loop for option in macro-clauses
                      collect (process-option option 'readtable))
              ,@(loop for option in syntax-clauses
                      collect (process-option option 'readtable))
              readtable)))))))

(eval-when (:load-toplevel :execute) (let ((readtable (find-readtable (quote mgl-pax:macro)))) (cond ((not readtable) (setq readtable (make-readtable (quote mgl-pax:macro)))) (t (setq readtable (%clear-readtable readtable)) (simple-style-warn "Overwriting already existing readtable ~S." readtable))) (setf (documentation readtable (quote readtable)) nil) (defun #:source-location-dummy150 nil) (%associate-dummy-with-readtable readtable (quote #:source-location-dummy150)) readtable))


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

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

Input: (enable-dot-syntax)

Output:
(defmacro enable-dot-syntax ()
  "Enable reader syntax."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
    (%enable-dot-syntax)))

(eval-when (:compile-toplevel :load-toplevel :execute) (%enable-dot-syntax))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-unique-names (repeat) `(block nil (tagbody ,repeat ,@*body* (go ,repeat))))

Problem: Macro call that should be transformed by with-unique-names

Input: (with-unique-names (repeat) `(block nil (tagbody ,repeat ,@*body* (go ,repeat))))

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

(let ((repeat (gensym #A((6) base-char . "REPEAT")))) (quasiquote (block nil (tagbody #S(sb-impl::comma :expr repeat :kind 0) #S(sb-impl::comma :expr *body* :kind 2) (go #S(sb-impl::comma :expr repeat :kind 0))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-flow-function-macro (body-fu lambda-list body) `(dispatch-atomically ,flow-context #',body-fu ,invariant ,@opts))

Pattern to recognize: Macro call that should be transformed by with-flow-function-macro

Input: (with-flow-function-macro (body-fu lambda-list body) `(dispatch-atomically ,flow-context #',body-fu ,invariant ,@opts))

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-input-from-file (input from :element-type element-type) (with-output-to-file (output to :element-type element-type :if-exists if-to-exists) (copy-stream input output :element-type element-type :finish-output finish-output)))

Issue: Macro call that should be transformed by with-input-from-file

Input: (with-input-from-file (input from :element-type element-type) (with-output-to-file (output to :element-type element-type :if-exists if-to-exists) (copy-stream input output :element-type element-type :finish-output finish-output)))

Output:
(defmacro with-input-from-file ((stream-name file-name &rest args
                                             &key (direction nil direction-p)
                                             &allow-other-keys)
                                &body body)
  "Evaluate BODY with STREAM-NAME to an input 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-INPUT-FROM-FILE."))
  `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
     ,@body))

(with-open-file* (input from :direction :input :element-type element-type) (with-output-to-file (output to :element-type element-type :if-exists if-to-exists) (copy-stream input output :element-type element-type :finish-output finish-output)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(lambda-ignoring-_ (_kwd exp) (expand-toplevel-const-exp exp))

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

Input: (lambda-ignoring-_ (_kwd exp) (expand-toplevel-const-exp exp))

Output:
(defmacro lambda-ignoring-_ (lambda-list &body body)
  "Works like `cl:lambda' macro except automatically `declare's
 `ignore' for parameters beginning with '_' character."
  (let ((ignored-parameters
          (collect-_-symbol-in-lambda-list lambda-list)))
    (unless ignored-parameters
      (warn "No ignored parameters in: ~A" lambda-list))
    (multiple-value-bind (body decls doc)
        (parse-body body :documentation t)
      `(lambda ,lambda-list
         ,@ (if doc `(,doc))
         (declare (ignore ,@ignored-parameters))
         ,@decls
         ,@body))))

(lambda (_kwd exp) (declare (ignore _kwd)) (expand-toplevel-const-exp exp))


Instruction:
Generate a defmacro form that transforms code like this:
(deferror "55" object-state-error)

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

Input: (deferror "55" object-state-error)

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

(progn (define-condition object-state-error (database-error) nil) (setf (gethash "55" *error-table*) (quote object-state-error)))


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

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

Input: (->> nil)

Output: (defmacro ->> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-neo4j-fun get-relationship-property (relationship-id property) :get (:uri-spec (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

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

Input: (def-neo4j-fun get-relationship-property (relationship-id property) :get (:uri-spec (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

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

(progn (defun get-relationship-property (&key relationship-id property) (let ((uri (format nil "relationship/~A/properties/~A" relationship-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (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))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote property-not-found-error) :uri uri))))))))


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

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

Input: (ignore-errors nil :key nil)

Output: (defmacro IGNORE-ERRORS ...)

(handler-case (progn nil :key nil) (error (condition) (values nil condition)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-error invalid-shader-stage () (stage) "Sorry but '~a' is not a valid shader stage" stage)

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

Input: (define-error invalid-shader-stage () (stage) "Sorry but '~a' is not a valid shader stage" stage)

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

(defcondition invalid-shader-stage (:error-type varjo-error :prefix "Varjo") (stage) "Sorry but '~a' is not a valid shader stage" stage)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-html-string (:li :class (progn nil)))

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

Input: (with-html-string (:li :class (progn nil)))

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

(with-output-to-string (*html*) (with-html (:li :class (progn nil))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun/1 fabs (x) (abs x))

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

Input: (defun/1 fabs (x) (abs x))

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-neo4j-fun get-relationships-types () :get (:uri-spec "relationship/types") (:status-handlers (200 (decode-neo4j-json-output body))))

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

Input: (def-neo4j-fun get-relationships-types () :get (:uri-spec "relationship/types") (: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 get-relationships-types (&key) (let ((uri "relationship/types") (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:
Create a Common Lisp macro for the following transformation. Before code:
(when-let ((x 2) (y x)) (+ x y))

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

Input: (when-let ((x 2) (y x)) (+ x y))

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

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

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

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

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

(let ((x 2) (y x)) (when (and x y) (+ x y)))


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

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

Input:
(with-dot nil
  (progn))

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-simple-definition-resolver ir1-convert (designator) (sb-int:info :function :ir1-convert designator))

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

Input: (define-simple-definition-resolver ir1-convert (designator) (sb-int:info :function :ir1-convert designator))

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

(define-definition-resolver ir1-convert (ir1-convert #:package151) (when (ignore-errors (let ((designator ir1-convert)) (sb-int:info :function :ir1-convert designator))) (list (make-instance (quote ir1-convert) :designator ir1-convert :package #:package151))))


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

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

Input: (mapping nil :key nil)

Output: (defmacro MAPPING ...)


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

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

Input: (is (plusp result))

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


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

Problem: Macro call that should be transformed by UNWIND-PROTECT

Input:
(unwind-protect nil
    nil)

Output: (defmacro UNWIND-PROTECT ...)


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

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

Input: (collect-hash nil :key nil)

Output: (defmacro COLLECT-HASH ...)

(common-lisp:let* ((#:out-160 (make-hash-table nil)))
  (common-lisp:let ((#:generator-164 (generator :key))
                    #:values-156
                    (#:generator-162 (generator nil))
                    #:keys-155)
    (declare (type generator #:generator-164)
             (type generator #:generator-162))
    (tagbody
     #:ll-165
      (setq #:values-156 (next-in #:generator-164 (go end)))
      (setq #:keys-155 (next-in #:generator-162 (go end)))
      (setf (gethash #:keys-155 #:out-160) #:values-156)
      (go #:ll-165)
     end)
    #:out-160))


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

Issue: Macro call that should be transformed by JS

Input: (js 'some-name)

Output: (defmacro JS ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(check-cursor-attached cluffer:insert-item (cursor item))

Write a macro that addresses: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:insert-item (cursor item))

Output:
(defmacro check-cursor-attached (name arguments)
  (let ((args (substitute '(cursor cluffer:cursor) 'cursor arguments)))
    `(defmethod ,name :before ,args
       (declare (ignore ,@(set-difference (remove 'cursor arguments)
                                          lambda-list-keywords)))
       (unless (cluffer:cursor-attached-p cursor)
         (error 'cluffer:cursor-detached)))))

(defmethod cluffer:insert-item :before ((cursor cluffer:cursor) item) (declare (ignore item)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


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

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

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

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


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

Problem: Macro call that should be transformed by GATHERING

Input:
(gathering nil
  nil)

Output: (defmacro GATHERING ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(letrec-syntax common-lisp:nil common-lisp:nil)

Problem: Macro call that should be transformed by LETREC-SYNTAX

Input: (letrec-syntax common-lisp:nil common-lisp:nil)

Output: (defmacro LETREC-SYNTAX ...)

(common-lisp:macrolet ()
  common-lisp:nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-element-maker :textarea "textArea" '(:x :y :width :height))

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

Input: (define-element-maker :textarea "textArea" '(:x :y :width :height))

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

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


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

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

Input: (define-alias-binding collect collecting)

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

(progn (setf (binding (quote collect)) (quote collecting)) (quote collect))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-wcs-math-error-handling ((quotient remainder) (round x y)) (check-wcs-math-result) (values (coerce remainder 'double-float) (coerce quotient 'double-float)))

What needs to change: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling ((quotient remainder) (round x y)) (check-wcs-math-result) (values (coerce remainder 'double-float) (coerce quotient 'double-float)))

Output:
(defmacro with-wcs-math-error-handling
    ((var-or-var-list
      (function x &optional (y nil y-supplied-p))
      &rest keyargs
      &key underflow-value)
     &body body)
  (declare (ignorable underflow-value))
  (let ((x_ (gensym)) (y_ (gensym)) (args_ (gensym))
        (var-list (ensure-list var-or-var-list)))
    `(let* ((,x_ ,x)
            (,y_ ,y)
            (,args_ (list ,x_ ,@(if y-supplied-p `(,y_)))))
       (declare (ignorable ,y_)
                (type list ,args_)
                (dynamic-extent ,args_))
       (catch 'return-from-with-wcs-math-error-handling
         (multiple-value-bind ,var-list
             (call-with-wcs-math-error-handler ',function ,args_
                                               ,@keyargs)
           (flet ((check-wcs-math-result
                      (&optional (ret ,(first var-list))
                                 (arg-list ,args_))
                    (check-wcs-math-result ret arg-list)))
             ,@body))))))

(let* ((#:g260 x) (#:g261 y) (#:g262 (list #:g260 #:g261))) (declare (ignorable #:g261) (type list #:g262) (dynamic-extent #:g262)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (quotient remainder) (call-with-wcs-math-error-handler (quote round) #:g262) (flet ((check-wcs-math-result (&optional (ret quotient) (arg-list #:g262)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result) (values (coerce remainder (quote double-float)) (coerce quotient (quote double-float)))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(when spec --indent (format stream "~&~a~a:" indent spec) ++indent)

Issue: Macro call that should be transformed by when

Input: (when spec --indent (format stream "~&~a~a:" indent spec) ++indent)

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

(if spec (progn --indent (format stream "~&~a~a:" indent spec) ++indent))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(builder (:auth/basic :authenticator (lambda (user pass) (declare (ignore user pass)) t)) *app*)

Problem: Macro call that should be transformed by builder

Input: (builder (:auth/basic :authenticator (lambda (user pass) (declare (ignore user pass)) t)) *app*)

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 (#:app176) (funcall (find-middleware :auth/basic) #:app176 :authenticator (lambda (user pass) (declare (ignore user pass)) t))))) :initial-value (to-app *app*) :from-end t)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-error flow-id-must-be-specified-vv (:error-type varjo-critical-error) () "v-values must be given a flow id when created")

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

Input: (define-error flow-id-must-be-specified-vv (:error-type varjo-critical-error) () "v-values must be given a flow id when created")

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

(defcondition flow-id-must-be-specified-vv (:error-type varjo-critical-error :prefix "Varjo") nil "v-values must be given a flow id when created")


Instruction:
Define a macro that eliminates this repetitive pattern:
(unwind-protect-case () (random 10) (:always (push :always result)) (:normal (push :normal result)) (:abort (push :abort result)))

Issue: Macro call that should be transformed by unwind-protect-case

Input: (unwind-protect-case () (random 10) (:always (push :always result)) (:normal (push :normal result)) (:abort (push :abort 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+124 t)) (unwind-protect (multiple-value-prog1 (random 10) (setf #:flag+124 nil)) (let nil (progn (push :always result)) (when (not #:flag+124) (push :normal result)) (when #:flag+124 (push :abort result)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-preprocessor-state-slots (state) (loop for i = (first token-list) while token-list until (eq i +newline-marker+) do (pop token-list) collect i))

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

Input: (with-preprocessor-state-slots (state) (loop for i = (first token-list) while token-list until (eq i +newline-marker+) do (pop token-list) collect i))

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

(with-accessors ((file-pathname pp-state-file-pathname) (token-list pp-state-token-list) (result-list pp-state-result-list) (line-number pp-state-line-number) (tokens-in-line pp-state-tokens-in-line) (macro-alist pp-state-macro-alist) (if-section-stack pp-state-if-section-stack) (if-section-skip-reason pp-state-if-section-skip-reason) (include-stack pp-state-include-stack)) state (loop for i = (first token-list) while token-list until (eq i +newline-marker+) do (pop token-list) collect i))


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

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

Input: (with-packages-unlocked nil)

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

(let ((#:|packages120| (locked-packages 'nil)))
  (unlock-packages #:|packages120|)
  (unwind-protect (lock-packages #:|packages120|)))


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

Problem: Macro call that should be transformed by FGATHER-NEXT

Input: (fgather-next nil (progn))

Output: (defmacro FGATHER-NEXT ...)


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

Problem: Macro call that should be transformed by DEFUN

Input: (defun nil ())

Output: (defmacro DEFUN ...)

(progn
 (eval-when (:compile-toplevel) (sb-c:%compiler-defun 'nil t nil nil))
 (sb-impl::%defun 'nil
                  (sb-int:named-lambda nil
                      nil
                    (block nil))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(destructuring-bind () (progn))

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

Input: (destructuring-bind () (progn))

Output: (defmacro DESTRUCTURING-BIND ...)

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(do-generator (item generator) (push (funcall function item) result))

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

Input: (do-generator (item generator) (push (funcall function item) result))

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 ((#:g169 generator)) (loop do (if-generator ((item) #:g169) (progn (push (funcall function item) result)) (return))))


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

Problem: Macro call that should be transformed by AND

Input: (and nil (progn))

Output: (defmacro AND ...)


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

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

Output: (defmacro -> ...)


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

Issue: Macro call that should be transformed by letrec

Input: (letrec (x) x)

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(with-table-name nil (yield (else-op-var op)))

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

Input: (with-table-name nil (yield (else-op-var op)))

Output:
(defmacro with-table-name (table-name &body body)
  `(let ((*table-name-scope* ,table-name))
     ,@body))

(let ((*table-name-scope* nil)) (yield (else-op-var op)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-package (package) (do-symbols (symbol package) (when (eql (symbol-package symbol) package) (when (fboundp symbol) (fmakunbound symbol)) (when (boundp symbol) (makunbound symbol)))) (delete-package package))

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

Input: (with-package (package) (do-symbols (symbol package) (when (eql (symbol-package symbol) package) (when (fboundp symbol) (fmakunbound symbol)) (when (boundp symbol) (makunbound symbol)))) (delete-package package))

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

(let ((package (ensure-package package))) (do-symbols (symbol package) (when (eql (symbol-package symbol) package) (when (fboundp symbol) (fmakunbound symbol)) (when (boundp symbol) (makunbound symbol)))) (delete-package package))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(without-trailing-space (funcall body))

Write a macro that addresses: Macro call that should be transformed by without-trailing-space

Input: (without-trailing-space (funcall body))

Output:
(defmacro without-trailing-space (&body body)
  (with-thunk (body)
    `(call-without-trailing-space ,body)))

(flet ((#:stack-fn-body1 nil (funcall body))) (declare (dynamic-extent (function #:stack-fn-body1))) (symbol-macrolet ((#:stack-fn-body1 (function #:stack-fn-body1))) (call-without-trailing-space #:stack-fn-body1)))


Instruction:
Generate a defmacro form that transforms code like this:
;; format with constant control strings interprets directives at runtime
(format nil "Value: ~a, Name: ~a" val name)
;; Every call: parse the ~a directives, resolve them, dispatch formatting
;; The format string is known at compile time but still interpreted at runtime

Pattern to recognize: format with compile-time-constant control strings wastes time interpreting directives at runtime — want compile-time compilation of format strings

Input:
;; format with constant control strings interprets directives at runtime
(format nil "Value: ~a, Name: ~a" val name)
;; Every call: parse the ~a directives, resolve them, dispatch formatting
;; The format string is known at compile time but still interpreted at runtime

Output:
(defun fformat (&rest all)
  (apply #'format all))

(define-compiler-macro fformat
                       (&whole form
                        stream fmt &rest args)
  (if (constantp fmt)
    (if stream
      `(funcall (formatter ,fmt)
         ,stream ,@args)
      (let ((g!stream (gensym "stream")))
        `(with-output-to-string (,g!stream)
           (funcall (formatter ,fmt)
             ,g!stream ,@args))))
    form))

;; (fformat t "Value: ~a, Name: ~a" val name)
;; Compiler macro sees constant fmt, expands to:
;; (FUNCALL (FORMATTER "Value: ~a, Name: ~a") T VAL NAME)
;;
;; formatter macro-expands the control string into direct
;; write-string, princ, etc. calls - no runtime parsing.
;;
;; When fmt is NOT constant: returns original form unchanged.
;; Graceful degradation - always correct, sometimes faster.


Instruction:
Generate a defmacro form that transforms code like this:
(make-instance* 'class () (when something (list :a a)))

Pattern to recognize: Macro call that should be transformed by make-instance*

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

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

Conveniences:

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

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

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

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

Examples:

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

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

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

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

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

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

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(with-iterators ((it sequence :from-end from-end :start start :end end)) (setf result (if initp initial-value (funcall key (with-iter-value (value it) value)))) (setf resultp t) (if from-end (do-iter-values ((item it)) (setf result (funcall f (funcall key item) result))) (do-iter-values ((item it)) (setf result (funcall f result (funcall key item))))))

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

Input: (with-iterators ((it sequence :from-end from-end :start start :end end)) (setf result (if initp initial-value (funcall key (with-iter-value (value it) value)))) (setf resultp t) (if from-end (do-iter-values ((item it)) (setf result (funcall f (funcall key item) result))) (do-iter-values ((item it)) (setf result (funcall f result (funcall key item))))))

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

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

   SEQS:

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

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

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

   FORMS:

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

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

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

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

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

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

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

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

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

                  ,@body))

             ;; Tagbody

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

             ;; Bindings

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

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

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

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

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

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

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

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

(symbol-macrolet nil (let* ((#:it161 (iterator sequence :from-end from-end :start start :end end))) (symbol-macrolet ((iter-value-macros ((it . #:iter-value162))) (iter-place-macros ((it . #:iter-place163)))) (macrolet ((#:iter-value162 (pattern &body body) (symbol-macrolet ((it (quote #:it161)) (tag (quote #:end-tag146))) (with-destructure-pattern (var pattern) (body decl body) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) (let ((#S(sb-impl::comma :expr var :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl :kind 2) (advance #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr body :kind 2))))))) (#:iter-place163 (name more? &body body) (symbol-macrolet ((it (quote #:it161)) (tag (quote #:end-tag146))) (let ((body (sb-int:quasiquote (prog1 (progn #S(sb-impl::comma :expr body :kind 2)) (advance #S(sb-impl::comma :expr it :kind 0)))))) (with-variable-declarations ((decl-name name) (decl-more? more?)) forms body (sb-int:quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr name :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl-name :kind 2) #S(sb-impl::comma :expr (if more? (sb-int:quasiquote (let ((#S(sb-impl::comma :expr more? :kind 0) (not (endp #S(sb-impl::comma :expr it :kind 0))))) #S(sb-impl::comma :expr decl-more? :kind 2) #S(sb-impl::comma :expr forms :kind 0))) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) #S(sb-impl::comma :expr forms :kind 0)))) :kind 0)))))))) (tagbody (setf result (if initp initial-value (funcall key (with-iter-value (value it) value)))) (setf resultp t) (if from-end (do-iter-values ((item it)) (setf result (funcall f (funcall key item) result))) (do-iter-values ((item it)) (setf result (funcall f result (funcall key item))))) #:end-tag146)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-connection (let ((user (retrieve-one (select :* (from :user) (where (:= :name "nitro_idiot")))))) (is user `(:id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created-at ,(princ-to-string *now*) :updated-at nil))))

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

Input: (with-connection (let ((user (retrieve-one (select :* (from :user) (where (:= :name "nitro_idiot")))))) (is user `(:id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created-at ,(princ-to-string *now*) :updated-at nil))))

Output:
(defmacro with-connection (&body body)
  `(let ((*connection* (connect-cached :sqlite3 :database-name *db-path*)))
     ,@body))

(let ((let (connect ((user (retrieve-one (select :* (from :user) (where (:= :name "nitro_idiot")))))) (is user (sb-int:quasiquote (:id 1 :name "nitro_idiot" :email "e.arrows@gmail.com" :status "normal" :created-at #S(sb-impl::comma :expr (princ-to-string *now*) :kind 0) :updated-at nil)))))) (unwind-protect (progn) (disconnect let)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-hamt dict (:test test :hash hash :table table) (flet ((%remove (table key) (%hamt-remove table key (funcall hash key) 0 test))) (make-instance 'hash-dict :test test :hash hash :table (reduce #'%remove keys :initial-value table))))

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

Input: (with-hamt dict (:test test :hash hash :table table) (flet ((%remove (table key) (%hamt-remove table key (funcall hash key) 0 test))) (make-instance 'hash-dict :test test :hash hash :table (reduce #'%remove keys :initial-value table))))

Output:
(defmacro with-hamt (hamt (&key test hash table) &body body)
  "Accessing HAMT slots"
  `(with-accessors ((,test hamt-test)
                    (,hash hamt-hash)
                    (,table hamt-table))
       ,hamt
     ,@body))

(with-accessors ((test hamt-test) (hash hamt-hash) (table hamt-table)) dict (flet ((%remove (table key) (%hamt-remove table key (funcall hash key) 0 test))) (make-instance (quote hash-dict) :test test :hash hash :table (reduce (function %remove) keys :initial-value table))))


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

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

Input:
(destructuring-bind* nil
    (progn))

Output: (defmacro DESTRUCTURING-BIND* ...)

(let (#:in-body130)
  (flet ((#:handle131 (#:condition132)
           (unless #:in-body130
             (error
              (make-condition 'destructuring-error :lambda-list 'nil
                              :expression '(progn) :reason #:condition132)))))
    (declare (ignorable (function #:handle131)))
    (let ((#:value133 (progn)))
      (handler-bind ((error #'#:handle131))
        (destructuring-bind () #:value133 (setf #:in-body130 t) (locally))))))


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

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

Input: (set-dynamic nil (progn))

Output: (defmacro SET-DYNAMIC ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(actypecase :foo (string (list :string it)) (keyword (list :keyword it)) (symbol (list :symbol it)))

Issue: Macro call that should be transformed by actypecase

Input: (actypecase :foo (string (list :string it)) (keyword (list :keyword it)) (symbol (list :symbol it)))

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

(anaphoric ctypecase :foo (string (list :string it)) (keyword (list :keyword it)) (symbol (list :symbol it)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-op (:<= infix-op))

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

Input: (define-op (:<= infix-op))

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

(defstruct (<=-op (:include infix-op (name "<=")) (:constructor make-<=-op (left right))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-api find-readtable (name) (named-readtable-designator => (or readtable null)) "Looks for the readtable specified by NAME and returns it if it is found. Returns NIL otherwise." (cond ((readtablep name) name) ((reserved-readtable-name-p name) (find-reserved-readtable name)) ((%find-readtable name))))

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

Input: (define-api find-readtable (name) (named-readtable-designator => (or readtable null)) "Looks for the readtable specified by NAME and returns it if it is found. Returns NIL otherwise." (cond ((readtablep name) name) ((reserved-readtable-name-p name) (find-reserved-readtable name)) ((%find-readtable name))))

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

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

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

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

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

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

(progn (declaim (ftype (function (named-readtable-designator) (values (or readtable null) &optional)) find-readtable)) (locally (declare (sb-ext:muffle-conditions style-warning)) (defun find-readtable (name) "Looks for the readtable specified by NAME and returns it if it is found. Returns NIL otherwise." (locally (declare (sb-ext:unmuffle-conditions style-warning)) (cond ((readtablep name) name) ((reserved-readtable-name-p name) (find-reserved-readtable name)) ((%find-readtable name)))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-launched-iter nil
    nil)

Problem: Macro call that should be transformed by DEF-LAUNCHED-ITER

Input:
(def-launched-iter nil
    nil)

Output: (defmacro DEF-LAUNCHED-ITER ...)

(defun nil ()
  (let ((it (make-instance 'iterator :coro (lambda-coro))))
    (inext-or-error it)
    it))