Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(accase (car x) (:y (setf x :no)) (:z (setf x :yes)))

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

Input: (accase (car x) (:y (setf x :no)) (:z (setf x :yes)))

Output:
(defmacro accase (keyform &body cases)
  "Like CCASE, except binds the result of the keyform to IT (via LET) for the
scope of the cases. Unlike CCASE, the keyform/place doesn't receive new values
possibly stored with STORE-VALUE restart; the new value is received by IT."
  `(anaphoric ccase ,keyform ,@cases))

(anaphoric ccase (car x) (:y (setf x :no)) (:z (setf x :yes)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is-error (error 'my-condition) 'simple-error)

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

Input: (is-error (error 'my-condition) 'simple-error)

Output:
(defmacro is (got expected &rest args)
  (with-gensyms (duration result new-args desc)
    (once-only (expected)
      `(let* ((,new-args (list ,@args))
              (,desc (parse-description-and-test ,new-args)))
         (with-catching-errors (:description ,desc :expected ,expected)
           (with-duration ((,duration ,result) ,got)
             (test ,result ,expected ,new-args
                   :duration ,duration)))))))

(with-duration ((#:duration184 #:error183) (handler-case (error (quote my-condition)) (condition (#:error183) #:error183))) (test #:error183 (quote simple-error) nil :duration #:duration184 :got-form (quote (error (quote my-condition))) :test-fn (function typep) :report-expected-label "raise a condition"))


Instruction:
Generate a defmacro form that transforms code like this:
(define-value-binding table-pairs (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (cond (,next (update ,(first var) ,key) (update ,(second var) ,val)) (T (end-for)))))

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

Input: (define-value-binding table-pairs (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (cond (,next (update ,(first var) ,key) (update ,(second var) ,val)) (T (end-for)))))

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

(define-direct-binding table-pairs (var table) (let ((#:iterator157 (gensym #A((8) base-char . "ITERATOR"))) (#:next158 (gensym #A((4) base-char . "NEXT"))) (#:key159 (gensym #A((3) base-char . "KEY"))) (#:val160 (gensym #A((3) base-char . "VAL"))) (#:table156 (gensym #A((5) base-char . "TABLE")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:table156 table) (list #:iterator157 (list (quote hash-table-iterator) #:table156)) (list #:next158 nil) (list #:key159 nil) (list #:val160 nil) (loop for #:var155 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var155 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:iterator157 :kind 0) #S(sb-impl::comma :expr #:next158 :kind 0) #S(sb-impl::comma :expr #:key159 :kind 0) #S(sb-impl::comma :expr #:val160 :kind 0) #S(sb-impl::comma :expr #:table156 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote hash-table) :kind 0) #S(sb-impl::comma :expr #:table156 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote function) :kind 0) #S(sb-impl::comma :expr #:iterator157 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((iterator #:iterator157) (next #:next158) (key #:key159) (val #:val160) (table #:table156)) (declare (ignorable iterator next key val table)) (sb-int:quasiquote (multiple-value-bind (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr val :kind 0)) (funcall #S(sb-impl::comma :expr iterator :kind 0)) (cond (#S(sb-impl::comma :expr next :kind 0) (update #S(sb-impl::comma :expr (first var) :kind 0) #S(sb-impl::comma :expr key :kind 0)) (update #S(sb-impl::comma :expr (second var) :kind 0) #S(sb-impl::comma :expr val :kind 0))) (t (end-for)))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(sccase (car x) (:y (setf it :no)) (:z (setf it :yes)))

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

Input: (sccase (car x) (:y (setf it :no)) (:z (setf it :yes)))

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

(symbolic ccase (car x) (:y (setf it :no)) (:z (setf it :yes)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defsynonym :summing :sum)

Issue: Macro call that should be transformed by defsynonym

Input: (defsynonym :summing :sum)

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

(eval-always (setf (get (quote :summing) (quote synonym)) (quote :sum)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-bug nil-return-set () (form possible-set) "Could not establish return-set. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic form: ~a Possible Set: ~a" form possible-set)

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

Input: (define-bug nil-return-set () (form possible-set) "Could not establish return-set. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic form: ~a Possible Set: ~a" form possible-set)

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

(defcondition nil-return-set (:error-type varjo-error :prefix "Varjo Bug") (form possible-set) "Could not establish return-set. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic form: ~a Possible Set: ~a" form possible-set)


Instruction:
Generate a defmacro form that transforms code like this:
(when (eql (top-sign) 'skip-first-parameter) (pop-sign))

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

Input: (when (eql (top-sign) 'skip-first-parameter) (pop-sign))

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

(if (eql (top-sign) (quote skip-first-parameter)) (pop-sign))


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

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

Input: (matrix-ccase 'some-name)

Output: (defmacro MATRIX-CCASE ...)


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

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

Input:
(some-<>
  nil
  nil)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-generic generic (a b &key c) "Body consisting of pseudo-documentation.")

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

Input: (define-generic generic (a b &key c) "Body consisting of pseudo-documentation.")

Output:
(defmacro define-generic (name (&rest arglist) &body body)
  "Convenience macro to define generics as if they were methods.
ARGLIST can be a method arglist, in which case it's parsed into
generic function arglist by removing method-specific args.

BODY can be a list of `defgeneric' options (processed as-is, even
:method ones) intermixed with other Lisp forms:
- If there's a docstring as the first form, it's processed into
  :documentation option of `defgeneric'.
- If there are non-option forms, they are put together into a separate
  :method option under ARGLIST.
- If there's a `declare' form:
  - If it's generic-friendly (optimize for speed or space), then it's
    put into both generic body and :method body (if any).
  - Otherwise it's only put into :method (creating it if necessary).
- If there's an `:export-generic-name-p' boolean option, export (T) or
  don't export (NIL) the generic symbol.

Example:

\(define-generic add ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
  \"Adds A and B, coercing them to fixnum if the sum is too big.\"
  (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\")))
=>
\(defgeneric add (a b &key &allow-other-keys)
  (:method ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
   (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b)))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\"))
  (:documentation \"Adds A and B, coercing them to fixnum if the sum is too big.\"))"
  (multiple-value-bind (body declarations documentation)
      (uiop:parse-body body :documentation t)
    (when (and (= 1 (length body))
               (stringp (first body)))
      (style-warn "Body of DEFINE-GENERIC contains a single string:
~s.
It's interpreted as a method body by default.

If you meant this string to be a generic docstring, and not a method
body, add an explicit NIL or some other body form:
(define-generic name (arg1 arg2)
  \"Docstring\"
  'body-form)

If you meant it as a body form, do nothing, or provide explicit
documentation or any other option:
(define-generic name (arg1 arg2)
  \"Docstring\"
  (:documentation \"Real docstring\"))" (first body)))
    (let* ((generic-declarations (remove-if (lambda (d)
                                              (or (> (length d) 2)
                                                  (not (eq 'optimize (first (second d))))
                                                  (notevery (lambda (o)
                                                              (let ((feature (first (uiop:ensure-list o))))
                                                                (or (eq feature 'speed)
                                                                    (eq feature 'space))))
                                                            (rest (second d)))))
                                            declarations))
           (options (remove-if-not (lambda (form)
                                     (keywordp (first (uiop:ensure-list form))))
                                   body))
           (method-body (remove-if (lambda (f) (member f options :test #'equal)) body))
           (export-generic-name-p (find :export-generic-name-p options :key #'first))
           (options (remove export-generic-name-p options :test #'equal))
           (export-p (if export-generic-name-p
                         (second export-generic-name-p)
                         *export-generic-name-p*))
           (generalized-arglist (generalize-arglist arglist)))
      (when (and (not (equal generalized-arglist arglist))
                 (every #'null (list method-body options)))
        (style-warn "Specialized arglist used without method body in define-generic: ~a" arglist))
      `(prog1
           (defgeneric ,name ,generalized-arglist
             ,@generic-declarations
             ,@(when (or method-body
                         (not (equal generic-declarations
                                     declarations)))
                 `((:method ,arglist
                     ,@declarations
                     ,@method-body)))
             ,@options
             ,@(when documentation
                 `((:documentation ,documentation))))
         ;; FIXME: Maybe only export if package of generic function name
         ;; matches *PACKAGE*?
         ,@(when export-p
             `((eval-when (:compile-toplevel :load-toplevel :execute)
                 (export ',name ,(package-name *package*)))))
         ,@(let ((documentation (or documentation
                                    (second (first (member :documentation options :key #'first))))))
             (when documentation
               `((setf (documentation ',name 'function) ,documentation)
                 (setf (documentation (fdefinition ',name) 'function) ,documentation))))))))

(prog1 (defgeneric generic (a b &key c) (:method (a b &key c) "Body consisting of pseudo-documentation.")))


Instruction:
Generate a defmacro form that transforms code like this:
(action (:after node-abstraction) #'handle-pop-hoist-point)

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

Input: (action (:after node-abstraction) #'handle-pop-hoist-point)

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

(make-action (quote :after) (quote node-abstraction) (function handle-pop-hoist-point))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(whichever a b c)

Problem: Macro call that should be transformed by whichever

Input: (whichever a b c)

Output:
(defmacro whichever (&rest possibilities &environment env)
  "Evaluates exactly one of POSSIBILITIES, chosen at random."
  (setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities))
  (let ((length (length possibilities)))
    (cond
      ((= 1 length)
       (first possibilities))
      ((every #'constantp possibilities)
       `(svref (load-time-value (vector ,@possibilities))
               (random ,length)))
      (T
       (labels ((expand (possibilities position random-number)
                  (if (null (cdr possibilities))
                      (car possibilities)
                      (let* ((length (length possibilities))
                             (half (truncate length 2))
                             (second-half (nthcdr half possibilities))
                             (first-half (butlast possibilities (- length half))))
                        `(if (< ,random-number ,(+ position half))
                             ,(expand first-half position random-number)
                             ,(expand second-half (+ position half) random-number))))))
         (with-gensyms (random-number)
           `(let ((,random-number (random ,length)))
              ,(expand possibilities 0 random-number))))))))

(let ((#:random-number136 (random 3))) (if (< #:random-number136 1) a (if (< #:random-number136 2) b c)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-cache ("foo" :expire 2 :store storage) 1)

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

Input: (with-cache ("foo" :expire 2 :store storage) 1)

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

Example:

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

(let ((#:key247 "foo") (#:store248 storage) (#:expire249 2)) (multiple-value-bind (#:value250 #:exists-p251) (getcache #:key247 #:store248) (if #:exists-p251 #:value250 (let ((#:value250 (progn 1))) (setcache #:key247 #:value250 #:store248 :expire #:expire249) #:value250))))


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator (item generator) (funcall function item))

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) `(progn (%defhook-fun ,hook-name ,vanilla-lambda-list ,@body) (%define-method-dispatch ,generic-function ,qualifier ,specialized-lambda-list)))

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

Input: (with-effective-qualifier generic-function qualifier (intern-hook generic-function hook-name type-list qualifier) `(progn (%defhook-fun ,hook-name ,vanilla-lambda-list ,@body) (%define-method-dispatch ,generic-function ,qualifier ,specialized-lambda-list)))

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

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

(let ((qualifier (effective-qualifier generic-function qualifier))) (intern-hook generic-function hook-name type-list qualifier) (sb-int:quasiquote (progn (%defhook-fun #S(sb-impl::comma :expr hook-name :kind 0) #S(sb-impl::comma :expr vanilla-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)) (%define-method-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr specialized-lambda-list :kind 0)))))


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

Problem: Macro call that should be transformed by WITH-CURRENT-SOURCE-FORM

Input: (with-current-source-form 'some-name)

Output: (defmacro WITH-CURRENT-SOURCE-FORM ...)


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

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

Input:
(resolving
  'some-name)

Output: (defmacro RESOLVING ...)


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

Issue: Macro call that should be transformed by PRODUCING

Input: (producing nil (progn))

Output: (defmacro PRODUCING ...)


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

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

Input: (some-> nil nil)

Output: (defmacro SOME-> ...)


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

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

Input: (dynamic-let nil)

Output: (defmacro DYNAMIC-LET ...)

(let ()
  (dynamic-wind
    :proceed
    #:g192
    (let ()
      (declare (special))
      (#:g192))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(awhen (incf x) (+ 1 it))

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

Input: (awhen (incf x) (+ 1 it))

Output:
(defmacro awhen (test &body body)
  "Like WHEN, except binds the result of the test to IT (via LET) for the scope
of the body."
  `(anaphoric when ,test ,@body))

(let ((it (incf x))) (when it (+ 1 it)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun get-node-relationships (node-id direction types) :get (:uri-spec (format nil "node/~A/relationships/~A/~{~A~^\\&~}" node-id (cond ((null direction) "all") ((symbolp direction) (string-downcase (symbol-name direction))) (t direction)) types)) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

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

Input: (def-neo4j-fun get-node-relationships (node-id direction types) :get (:uri-spec (format nil "node/~A/relationships/~A/~{~A~^\\&~}" node-id (cond ((null direction) "all") ((symbolp direction) (string-downcase (symbol-name direction))) (t direction)) types)) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

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

(progn (defun get-node-relationships (&key node-id direction types) (let ((uri (format nil "node/~A/relationships/~A/~{~A~^\\&~}" node-id (cond ((null direction) "all") ((symbolp direction) (string-downcase (symbol-name direction))) (t direction)) 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))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(compile-$flavor-$methods 'some-name)

Issue: Macro call that should be transformed by COMPILE-$FLAVOR-$METHODS

Input: (compile-$flavor-$methods 'some-name)

Output: (defmacro COMPILE-$FLAVOR-$METHODS ...)

(eval-when (:load-toplevel) (combine-class-methods 'some-name))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(gen-lambda-with-sticky-stop () (multiple-value-bind (res signal) (funcall source) (if signal res (sticky-stop))))

Problem: Macro call that should be transformed by gen-lambda

Input: (gen-lambda-with-sticky-stop () (multiple-value-bind (res signal) (funcall source) (if signal res (sticky-stop))))

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

(make-instance (quote basic-generator) :function (sticky-stop-lambda nil (multiple-value-bind (res signal) (funcall source) (if signal res (sticky-stop)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-atomic-updates 'with-atomic-updates)

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

Input: (with-atomic-updates 'with-atomic-updates)

Output:
(defmacro with-atomic-updates ((&rest variables) &body body)
  ;;Self-binding is necessary to avoid losing the previous value
  `(with-atomic-updates* ,variables (let ,(mapcar (lambda (var) (list var var)) variables)) ,@body))

(with-atomic-updates* (quote with-atomic-updates) (let ((quote quote) (with-atomic-updates with-atomic-updates))))


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

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

Input: (ct-flet nil)

Output: (defmacro CT-FLET ...)

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


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

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

Input: (with-dot nil)

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


Instruction:
Generate a defmacro form that transforms code like this:
(c? (/ (len self) 2))

Pattern to recognize: Macro call that should be transformed by c?

Input: (c? (/ (len self) 2))

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

(make-c-dependent :code (quote ((/ (len self) 2))) :value-state :unevaluated :rule (c-lambda (/ (len self) 2)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-wcs-math-error-handling (ret (ffloor x)) (check-wcs-math-result))

Write a macro that addresses: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling (ret (ffloor x)) (check-wcs-math-result))

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* ((#:g245 x) (#:g246 nil) (#:g247 (list #:g245))) (declare (ignorable #:g246) (type list #:g247) (dynamic-extent #:g247)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote ffloor) #:g247) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g247)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(do-readtable (char readtable) (set-syntax-from-char char #\A readtable))

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

Input: (do-readtable (char readtable) (set-syntax-from-char char #\A readtable))

Output:
(defmacro do-readtable ((entry-designator readtable &optional result)
                        &body body)
  "Iterate through a readtable's macro characters, and dispatch macro characters."
  (destructuring-bind (char &optional reader-fn non-terminating-p disp? table)
      (if (symbolp entry-designator)
          (list entry-designator)
          entry-designator)
    (let ((iter (gensym "ITER+"))
          (more? (gensym "MORE?+"))
          (rt (gensym "READTABLE+")))
      `(let ((,rt ,readtable))
         (with-readtable-iterator (,iter ,rt)
           (loop
             (multiple-value-bind (,more?
                                   ,char
                                   ,@(when reader-fn (list reader-fn))
                                   ,@(when disp? (list disp?))
                                   ,@(when table (list table)))
                 (,iter)
               (unless ,more? (return ,result))
               (let ,(when non-terminating-p
                       ;; FIXME: N-T-P should be incorporated in iterators.
                       `((,non-terminating-p
                          (nth-value 1 (get-macro-character ,char ,rt)))))
                 ,@body))))))))

(let ((#:readtable+143 readtable)) (with-readtable-iterator (#:iter+141 #:readtable+143) (loop (multiple-value-bind (#:more?+142 char) (#:iter+141) (unless #:more?+142 (return nil)) (let nil (set-syntax-from-char char #\LATIN_CAPITAL_LETTER_A readtable))))))


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

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(ematch0 more-patterns (nil nil) ((list* _ subpattern more-patterns) (append (%variables subpattern) (%variables-more-patterns more-patterns))))

Issue: Macro call that should be transformed by ematch0

Input: (ematch0 more-patterns (nil nil) ((list* _ subpattern more-patterns) (append (%variables subpattern) (%variables-more-patterns more-patterns))))

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

(match0 more-patterns (nil nil) ((list* _ subpattern more-patterns) (append (%variables subpattern) (%variables-more-patterns more-patterns))) (_ (error "level0 match error!")))


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

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

Input:
(ct-let* nil
  nil)

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

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


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

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

Input: (check-cursor-attached cluffer:buffer (cursor))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(make-method-function-call (function-name info) args `(#'call-next-method ,(and next-method t)))

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

Input: (make-method-function-call (function-name info) args `(#'call-next-method ,(and next-method t)))

Output:
(defmacro make-method (form)
  `(cl:make-method ,form))

(make-method-function-call (function-name info) args (sb-int:quasiquote ((function call-next-method) #S(sb-impl::comma :expr (and next-method t) :kind 0))))


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

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

Input: (defsynonym until :until)

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defvar-unbound *start-char* "Bound to the opening outer delimiter while parsing a string.")

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

Input: (defvar-unbound *start-char* "Bound to the opening outer delimiter while parsing a string.")

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

(eval-when (:load-toplevel :compile-toplevel :execute) (defvar *start-char*) (setf (documentation (quote *start-char*) (quote variable)) "Bound to the opening outer delimiter while parsing a string."))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defannotation inline* (name) (:alias inline :inline t) "Shorthand for (DECLARE (INLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type '(defun defmethod))) `(progn (declaim (inline ,symbol)) ,name) `(declare (inline ,name)))))

Problem: Macro call that should be transformed by defannotation

Input: (defannotation inline* (name) (:alias inline :inline t) "Shorthand for (DECLARE (INLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type '(defun defmethod))) `(progn (declaim (inline ,symbol)) ,name) `(declare (inline ,name)))))

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

(progn (set-annotation-options (quote inline*) (quote (:alias inline :inline t))) (defmacro inline* (name) "Shorthand for (DECLARE (INLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type (quote (defun defmethod)))) (sb-int:quasiquote (progn (declaim (inline #S(sb-impl::comma :expr symbol :kind 0))) #S(sb-impl::comma :expr name :kind 0))) (sb-int:quasiquote (declare (inline #S(sb-impl::comma :expr name :kind 0))))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(ensure-gethash x table 42)

Problem: Macro call that should be transformed by ensure-gethash

Input: (ensure-gethash x table 42)

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

(let ((#:n-key-159 x) (#:n-hash-table-160 table)) (multiple-value-bind (#:value161 #:foundp162) (gethash #:n-key-159 #:n-hash-table-160) (if #:foundp162 (values #:value161 t) (values (setf (gethash #:n-key-159 #:n-hash-table-160) 42) nil))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(builder (:static :path (lambda (path-info) (when (starts-with-subseq "/static/" path-info) (subseq path-info #.(length "/static")))) :root (asdf:system-relative-pathname :lack #P"data/")) (lambda (env) (declare (ignore env)) `(200 (:content-type "text/plain") ("ok"))))

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

Input: (builder (:static :path (lambda (path-info) (when (starts-with-subseq "/static/" path-info) (subseq path-info #.(length "/static")))) :root (asdf:system-relative-pathname :lack #P"data/")) (lambda (env) (declare (ignore env)) `(200 (:content-type "text/plain") ("ok"))))

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 (#:app230) (funcall (find-middleware :static) #:app230 :path (lambda (path-info) (when (starts-with-subseq "/static/" path-info) (subseq path-info 7))) :root (asdf/system:system-relative-pathname :lack #P"data/"))))) :initial-value (to-app (lambda (env) (declare (ignore env)) (sb-int:quasiquote (200 (:content-type "text/plain") ("ok"))))) :from-end t)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(builder :session (:csrf :one-time t) #'(lambda (env) (let ((req (make-request env))) `(200 (:content-type "text/html") (,(if (and (eq :post (request-method req)) (assoc "name" (request-body-parameters req) :test #'string=)) (cdr (assoc "name" (request-body-parameters req) :test #'string=)) (html-form env)))))))

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

Input: (builder :session (:csrf :one-time t) #'(lambda (env) (let ((req (make-request env))) `(200 (:content-type "text/html") (,(if (and (eq :post (request-method req)) (assoc "name" (request-body-parameters req) :test #'string=)) (cdr (assoc "name" (request-body-parameters req) :test #'string=)) (html-form env)))))))

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 (find-middleware :session) (lambda (#:app206) (funcall (find-middleware :csrf) #:app206 :one-time t)))) :initial-value (to-app (function (lambda (env) (let ((req (make-request env))) (sb-int:quasiquote (200 (:content-type "text/html") (#S(sb-impl::comma :expr (if (and (eq :post (request-method req)) (assoc "name" (request-body-parameters req) :test (function string=))) (cdr (assoc "name" (request-body-parameters req) :test (function string=))) (html-form env)) :kind 0)))))))) :from-end t)


Instruction:
Generate a defmacro form that transforms code like this:
(match ARG (PATTERN BODY...))

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

Input: (match ARG (PATTERN BODY...))

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

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

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

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

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

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

will be translated to

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

Examples:

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

(%or (%or (let ((pattern arg)) body...) (fail)) nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(make-name-transformer "BAZ-" name)

What needs to change: Macro call that should be transformed by make-name-transformer

Input: (make-name-transformer "BAZ-" name)

Output:
(defmacro make-name-transformer (&rest elements)
  "Return an accessor name transformer.
The unquoted `name' symbol argument is substituted for the slot name.
Class option examples:

  :accessor-name-transformer (make-name-transformer \"FOO-\" name \"-BAR\")

Use the slot name directly:

  :accessor-name-transformer (make-name-transformer name)"
  `(lambda (name definition)
    (declare (ignorable definition))
    (concatenate-symbol ,@(mapcar (lambda (el)
                                    (if (and (symbolp el)
                                             (string= (symbol-name el) "NAME"))
                                        'name
                                        el))
                                  elements))))

(lambda (name definition) (declare (ignorable definition)) (concatenate-symbol "BAZ-" name))


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

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

Input:
(dynamic-wind
  nil
  (progn))

Output: (defmacro DYNAMIC-WIND ...)

(flet ((#:dynamic-wind-thunk222 (#:proceed-thunk223)
         (macrolet ((proceed (&body #:proceed-body224)
                      `(if ,'#:proceed-thunk223
                           (funcall (the function ,'#:proceed-thunk223))
                           (progn ,@#:proceed-body224))))
           nil
           (progn))))
  (declare (inline #:dynamic-wind-thunk222))
  (let ((*dynamic-wind-stack*
         (cons #'#:dynamic-wind-thunk222 *dynamic-wind-stack*)))
    (#:dynamic-wind-thunk222 nil)))


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

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

Input:
(defmacro+ps nil
    (progn))

Output: (defmacro DEFMACRO+PS ...)

(progn
 (defmacro nil (progn))
 (defpsmacro nil
     (progn)))


Instruction:
Generate a defmacro form that transforms code like this:
(defhandler defun (defun name lambda-list &rest body) `(list* ',defun ,(apply 'dump-fbinding name lambda-list body)))

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

Input: (defhandler defun (defun name lambda-list &rest body) `(list* ',defun ,(apply 'dump-fbinding name lambda-list body)))

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

(progn (defun hander-defun (defun name lambda-list &rest body) (sb-int:quasiquote (list* (quote #S(sb-impl::comma :expr defun :kind 0)) #S(sb-impl::comma :expr (apply (quote dump-fbinding) name lambda-list body) :kind 0)))) (setf (gethash (quote defun) *form-handler*) (quote hander-defun)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defalias path:absolute-p (pathname) cl-fad:pathname-absolute-p)

Issue: Macro call that should be transformed by defalias

Input: (defalias path:absolute-p (pathname) cl-fad:pathname-absolute-p)

Output:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

(progn (defun path:absolute-p (pathname) (pathname-absolute-p pathname)) (define-compiler-macro path:absolute-p (&rest args) (list* (quote pathname-absolute-p) args)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defvar-compile-time *block-tags* '() "This must be globally NIL.")

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

Input: (defvar-compile-time *block-tags* '() "This must be globally NIL.")

Output:
(defmacro defvar-compile-time (name &optional initial-value documentation)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defvar ,name ,initial-value ,documentation)))

(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *block-tags* (quote nil) "This must be globally NIL."))


Instruction:
Define a macro that eliminates this repetitive pattern:
(unwind-protect-case () (error "FOOF!") (:normal (push :normal result1)) (:abort (push :abort result1)) (:always (push :always result1)))

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

Input: (unwind-protect-case () (error "FOOF!") (:normal (push :normal result1)) (:abort (push :abort result1)) (:always (push :always result1)))

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+125 t)) (unwind-protect (multiple-value-prog1 (error "FOOF!") (setf #:flag+125 nil)) (let nil (when (not #:flag+125) (push :normal result1)) (when #:flag+125 (push :abort result1)) (progn (push :always result1)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun/1 clearerr (fd) (setf (feof fd) 0 (ferror fd) 0))

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

Input: (defun/1 clearerr (fd) (setf (feof fd) 0 (ferror fd) 0))

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 clearerr (fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (setf (feof fd) 0 (ferror fd) 0)) (defparameter clearerr (vacietis.c:mkptr& (symbol-function (quote clearerr)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error "Unknown item ~A in char-class list." item)

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

Input: (signal-syntax-error "Unknown item ~A in char-class list." item)

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

(signal-syntax-error* nil "Unknown item ~A in char-class list." item)


Instruction:
Define a macro that eliminates this repetitive pattern:
(class-stealth-mixins nil)

Issue: Macro call that should be transformed by CLASS-STEALTH-MIXINS

Input: (class-stealth-mixins nil)

Output: (defmacro CLASS-STEALTH-MIXINS ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-temp (d :directory t :debug (<= 1 *debug-prolog*)) (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (let* ((executable (namestring (make-pathname :type "out" :defaults input-file)))) (run-command-with-debug-print `("gplc" ,input-file "-o" ,executable) :input input :output output :error error) (run-command-with-debug-print `(,executable) :input input :output output :error error))))

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

Input: (with-temp (d :directory t :debug (<= 1 *debug-prolog*)) (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (let* ((executable (namestring (make-pathname :type "out" :defaults input-file)))) (run-command-with-debug-print `("gplc" ,input-file "-o" ,executable) :input input :output output :error error) (run-command-with-debug-print `(,executable) :input input :output output :error error))))

Output:
(defmacro with-temp ((var &key directory template (tmpdir "/tmp/") debug) &body body)
  "Create a temporary file, then remove the file by unwind-protect.
Most arguments are analogous to mktemp.
When DIRECTORY is non-nil, creates a directory instead.
DEBUG is a form.
When evaluated to non-nil, it does not remove the directory so that you can investigate what happened inside the directory.
It may be evaluated multiple times."
  (with-gensyms (command)
    `(let ((,var (uiop:run-program
                  (let ((,command (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]"
                                          ,tmpdir ,directory ,template)))
                    (when ,debug
                      (format *error-output* "~&; ~a~%" ,command))
                    ,command)
                  :output '(:string :stripped t))))
       (unwind-protect
            (progn ,@body)
         (if ,debug
             (format *error-output* "~&; not removing ~a for debugging~%" ,var)
             (uiop:run-program (format nil "rm -rf ~a" (namestring ,var)) :ignore-error-status t))))))

(let ((d (uiop/run-program:run-program (let ((#:command173 (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]" "/tmp/" t nil))) (when (<= 1 *debug-prolog*) (format *error-output* "~&; ~a~%" #:command173)) #:command173) :output (quote (:string :stripped t))))) (unwind-protect (progn (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (let* ((executable (namestring (make-pathname :type "out" :defaults input-file)))) (run-command-with-debug-print (sb-int:quasiquote ("gplc" #S(sb-impl::comma :expr input-file :kind 0) "-o" #S(sb-impl::comma :expr executable :kind 0))) :input input :output output :error error) (run-command-with-debug-print (sb-int:quasiquote (#S(sb-impl::comma :expr executable :kind 0))) :input input :output output :error error)))) (if (<= 1 *debug-prolog*) (format *error-output* "~&; not removing ~a for debugging~%" d) (uiop/run-program:run-program (format nil "rm -rf ~a" (namestring d)) :ignore-error-status t))))


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

Problem: Macro call that should be transformed by F_%

Input:
(f_%
  'some-name)

Output: (defmacro F_% ...)

(lambda (&rest #:|ignore130|) (declare (ignore #:|ignore130|)) 'some-name)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(assoc-cdr :message at-data)

Problem: Macro call that should be transformed by assoc-cdr

Input: (assoc-cdr :message at-data)

Output:
(defmacro assoc-cdr (key alist &optional (test '#'eql))
  `(cdr (assoc ,key ,alist :test ,test)))

(cdr (assoc :message at-data :test (function eql)))


Instruction:
Generate a defmacro form that transforms code like this:
(deferror "40001" serialization-failure transaction-rollback)

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

Input: (deferror "40001" serialization-failure transaction-rollback)

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

(progn (define-condition serialization-failure (transaction-rollback) nil) (setf (gethash "40001" *error-table*) (quote serialization-failure)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-iter iterator-starmap (base-iter fn) (starmap (fn iterable-of-iterables) "Applies `fn` to the first argument of `iterable-of-iterables`, then the second, etc ``` (starmap #'+ '(1 2) '(3 4)) ;; 3, 7 ```" (init-state (base-iter (make-iterator iterable-of-iterables)) fn)) (multiple-value-bind (base-item base-alive) (next base-iter) (if base-alive (values (apply fn (iter-to-list base-item)) t) (values nil nil))))

Problem: Macro call that should be transformed by def-iter

Input: (def-iter iterator-starmap (base-iter fn) (starmap (fn iterable-of-iterables) "Applies `fn` to the first argument of `iterable-of-iterables`, then the second, etc ``` (starmap #'+ '(1 2) '(3 4)) ;; 3, 7 ```" (init-state (base-iter (make-iterator iterable-of-iterables)) fn)) (multiple-value-bind (base-item base-alive) (next base-iter) (if base-alive (values (apply fn (iter-to-list base-item)) t) (values nil nil))))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname140 (&key base-iter fn) (labels ((self nil (multiple-value-bind (base-item base-alive) (next base-iter) (if base-alive (values (apply fn (iter-to-list base-item)) t) (values nil nil))))) (function self)))) (defun starmap (fn iterable-of-iterables) "Applies `fn` to the first argument of `iterable-of-iterables`, then the second, etc ``` (starmap #'+ '(1 2) '(3 4)) ;; 3, 7 ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname140)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (base-iter (make-iterator iterable-of-iterables)) fn))))


Instruction:
Generate a defmacro form that transforms code like this:
(alist-bind (name value) form (maybe-add-constant name value))

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

Input: (alist-bind (name value) form (maybe-add-constant name value))

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

(let ((#:alist245 form)) (let ((name (aval :name #:alist245)) (value (aval :value #:alist245))) (maybe-add-constant name value)))


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

Problem: Macro call that should be transformed by DO-FOR

Input:
(do-for nil
  :key
  nil)

Output: (defmacro DO-FOR ...)

(block nil (lc ((block nil (tagbody (return (progn :key nil))))) progn))


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

Problem: Macro call that should be transformed by WITH-STANDARD-READTABLE

Input:
(with-standard-readtable
  nil
  :key
  nil)

Output: (defmacro WITH-STANDARD-READTABLE ...)

(bind ((*readtable* (with-standard-io-syntax (copy-readtable *readtable*))))
  nil
  :key
  nil)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-bug name-mismatch (:error-type varjo-critical-error) (lisp glsl taken) "The glsl name ~s was generated for the lisp-name ~s However this clashes with glsl name for the previous symbol ~s. This is Varjo bug, please raise an issue on github. Sorry for the inconvenience" glsl lisp taken)

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

Input: (define-bug name-mismatch (:error-type varjo-critical-error) (lisp glsl taken) "The glsl name ~s was generated for the lisp-name ~s However this clashes with glsl name for the previous symbol ~s. This is Varjo bug, please raise an issue on github. Sorry for the inconvenience" glsl lisp taken)

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

(defcondition name-mismatch (:error-type varjo-critical-error :prefix "Varjo Bug") (lisp glsl taken) "The glsl name ~s was generated for the lisp-name ~s However this clashes with glsl name for the previous symbol ~s. This is Varjo bug, please raise an issue on github. Sorry for the inconvenience" glsl lisp taken)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (values (format nil "~A JOIN ~A~:[~;~:* ON ~A~]~:[~;~:* USING ~A~]" (join-clause-kind clause) (yield (join-clause-statement clause)) (if (join-clause-on clause) (yield (join-clause-on clause)) nil) (if (join-clause-using clause) (yield (join-clause-using clause)) nil))))

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

Input: (with-yield-binds (values (format nil "~A JOIN ~A~:[~;~:* ON ~A~]~:[~;~:* USING ~A~]" (join-clause-kind clause) (yield (join-clause-statement clause)) (if (join-clause-on clause) (yield (join-clause-on clause)) nil) (if (join-clause-using clause) (yield (join-clause-using clause)) nil))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (values (format nil "~A JOIN ~A~:[~;~:* ON ~A~]~:[~;~:* USING ~A~]" (join-clause-kind clause) (yield (join-clause-statement clause)) (if (join-clause-on clause) (yield (join-clause-on clause)) nil) (if (join-clause-using clause) (yield (join-clause-using clause)) nil)))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> #'any)

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

Input: (*> #'any)

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

(lambda (#:*>-offset160) (funcall (function any) #:*>-offset160))


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

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

Input: (skip)

Output: (defmacro skip () `(next))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-method-combination% max :operator max :identity-with-one-argument t)

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

Input: (define-method-combination% max :operator max :identity-with-one-argument t)

Output:
(defmacro define-method-combination% (name &rest args)
  "Define a method-combination for the static-dispatch system only.

   Arguments are of the same form as to CL:DEFINE-METHOD-COMBINATION."

  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (combination-function ',name)
      ,(match args
         ((or nil
              (list* (and (type symbol) (not nil)) _))

          (destructuring-bind (&key (operator name) (identity-with-one-argument nil))
              args

            `(method-combination-function-short ,name ,operator ,identity-with-one-argument)))

         (_
          `(method-combination-function ,name ,@args))))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (combination-function (quote max)) (method-combination-function-short max max t)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(maybe-once-only nil)

Issue: Macro call that should be transformed by MAYBE-ONCE-ONLY

Input: (maybe-once-only nil)

Output: (defmacro MAYBE-ONCE-ONLY ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(sif (car it) (setf it 'a) :foo)

Problem: Macro call that should be transformed by sif

Input: (sif (car it) (setf it 'a) :foo)

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

(symbolic if (car it) (setf it (quote a)) :foo)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-test shuffle :serial NIL (true 1) (true 2) (true 3) (true 4) (true 5))

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

Input: (define-test shuffle :serial NIL (true 1) (true 2) (true 3) (true 4) (true 5))

Output:
(defmacro define-test (name &body arguments-and-body)
  (destructuring-bind (nparent name) (if (listp name) name (list NIL name))
    (form-fiddle:with-body-options (body options parent home (test-class 'test) (compile-at :compile-time) defun) arguments-and-body
      (let ((body (remove 'define-test body :key (lambda (a) (when (listp a) (car a))) :test #'eql))
            (defs (remove 'define-test body :key (lambda (a) (when (listp a) (car a))) :test-not #'eql))
            (home-form (or home `(find-package ,(package-name *package*)))))
        (when (and parent nparent)
          (error "Cannot specify parent through name and through a keyword argument at the same time!"))
        `(let ((*package* (find-package ,(package-name *package*)))) ; Make sure package stays consistent throughout initialisation.
           (setf (find-test ',name ,home-form)
                 (ensure-test ',test-class
                              :name ',name
                              :home ,home-form
                              :tests (list ,@(loop for form in body
                                                   collect (ecase compile-at
                                                             (:compile-time `(lambda () ,form))
                                                             (:execute `(lambda () (call-compile ',form))))))
                              :parent ',(or parent nparent)
                              ,@(loop for option in options
                                      collect `',option)))
           ,@(loop for (def subname . body) in defs
                   collect `(,def (,name ,subname)
                              :home ,home
                              ,@body))
           ,@(when defun
               `((defun ,(if (stringp name) (read-symbol name) name) (&rest test-args)
                   (apply #'test (find-test ',name ,home-form) test-args))))
           ',name)))))

(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote shuffle) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote shuffle) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (true 1)) (lambda nil (true 2)) (lambda nil (true 3)) (lambda nil (true 4)) (lambda nil (true 5))) :parent (quote nil) (quote :serial) (quote nil))) (quote shuffle))


Instruction:
Generate a defmacro form that transforms code like this:
(-> (one) :ignore-invariant t () (increment))

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

Input: (-> (one) :ignore-invariant t () (increment))

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

(atomically (one) :ignore-invariant t nil (increment))


Instruction:
Define a macro that eliminates this repetitive pattern:
(parse-conjunctive-clauses client instance nil :var (parse-d-spec client))

Issue: Macro call that should be transformed by parse-conjunctive-clauses

Input: (parse-conjunctive-clauses client instance nil :var (parse-d-spec client))

Output:
(defmacro parse-conjunctive-clauses (client region read-name-p &rest args)
  (with-unique-names (clauses next)
    `(prog (,clauses)
      ,next
        (push (do-parse-clause ,client ,region *index* ,read-name-p ,@args)
              ,clauses)
        (when (maybe-parse-token :keywords '(:and))
          (go ,next))
        (return (nreverse ,clauses)))))

(prog (#:clauses126) #:next127 (push (do-parse-clause client instance *index* nil :var (parse-d-spec client)) #:clauses126) (when (maybe-parse-token :keywords (quote (:and))) (go #:next127)) (return (nreverse #:clauses126)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error* (1- (lexer-pos lexer)) "Opening #\< in named group has no closing #\>.")

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

Input: (signal-syntax-error* (1- (lexer-pos lexer)) "Opening #\< in named group has no closing #\>.")

Output:
(defmacro signal-syntax-error* (pos format-control &rest format-arguments)
  `(error 'ppcre-syntax-error
          :pos ,pos
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

(error (quote ppcre-syntax-error) :pos (1- (lexer-pos lexer)) :format-control "Opening #< in named group has no closing #>." :format-arguments (list))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op)))))

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

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

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op))))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)

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

Input: (defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)

Output:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

(progn (defun path:catdir (&rest pathnames) (apply (function merge-pathnames-as-directory) pathnames)) (define-compiler-macro path:catdir (&rest args) (list* (quote merge-pathnames-as-directory) args)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)

Problem: Macro call that should be transformed by defalias

Input: (defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)

Output:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

(progn (defun path:catfile (&rest pathnames) (apply (function merge-pathnames-as-file) pathnames)) (define-compiler-macro path:catfile (&rest args) (list* (quote merge-pathnames-as-file) args)))


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

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

Input:
(dynamic-wind
  nil
  nil)

Output: (defmacro DYNAMIC-WIND ...)

(flet ((#:dynamic-wind-thunk219 (#:proceed-thunk220)
         (macrolet ((proceed (&body #:proceed-body221)
                      `(if ,'#:proceed-thunk220
                           (funcall (the function ,'#:proceed-thunk220))
                           (progn ,@#:proceed-body221))))
           nil
           nil)))
  (declare (inline #:dynamic-wind-thunk219))
  (let ((*dynamic-wind-stack*
         (cons #'#:dynamic-wind-thunk219 *dynamic-wind-stack*)))
    (#:dynamic-wind-thunk219 nil)))


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

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

Input:
(dletf nil
  (progn))

Output: (defmacro DLETF ...)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-wcs-math-error-handling (ret (log x (float 2 x))) (check-wcs-math-result))

Write a macro that addresses: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling (ret (log x (float 2 x))) (check-wcs-math-result))

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* ((#:g230 x) (#:g231 (float 2 x)) (#:g232 (list #:g230 #:g231))) (declare (ignorable #:g231) (type list #:g232) (dynamic-extent #:g232)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote log) #:g232) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g232)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


Instruction:
Generate a defmacro form that transforms code like this:
(do+ (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

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

Input: (do+ (options :atomic-updates nil) (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 (options :atomic-updates 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:
Generate a defmacro form that transforms code like this:
(define-custom-var (:symbols-package *json-symbols-package*) (find-package 'keyword))

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

Input: (define-custom-var (:symbols-package *json-symbols-package*) (find-package 'keyword))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*json-symbols-package* . :symbols-package)) *custom-vars* :test (function equal)) (defvar *json-symbols-package* (find-package (quote keyword)))))


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

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

Input: (-<>> nil nil)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-generic generic ((a a) (b b) &key (c nil) &allow-other-keys) (+ a b))

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

Input: (define-generic generic ((a a) (b b) &key (c nil) &allow-other-keys) (+ a b))

Output:
(defmacro define-generic (name (&rest arglist) &body body)
  "Convenience macro to define generics as if they were methods.
ARGLIST can be a method arglist, in which case it's parsed into
generic function arglist by removing method-specific args.

BODY can be a list of `defgeneric' options (processed as-is, even
:method ones) intermixed with other Lisp forms:
- If there's a docstring as the first form, it's processed into
  :documentation option of `defgeneric'.
- If there are non-option forms, they are put together into a separate
  :method option under ARGLIST.
- If there's a `declare' form:
  - If it's generic-friendly (optimize for speed or space), then it's
    put into both generic body and :method body (if any).
  - Otherwise it's only put into :method (creating it if necessary).
- If there's an `:export-generic-name-p' boolean option, export (T) or
  don't export (NIL) the generic symbol.

Example:

\(define-generic add ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
  \"Adds A and B, coercing them to fixnum if the sum is too big.\"
  (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\")))
=>
\(defgeneric add (a b &key &allow-other-keys)
  (:method ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
   (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b)))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\"))
  (:documentation \"Adds A and B, coercing them to fixnum if the sum is too big.\"))"
  (multiple-value-bind (body declarations documentation)
      (uiop:parse-body body :documentation t)
    (when (and (= 1 (length body))
               (stringp (first body)))
      (style-warn "Body of DEFINE-GENERIC contains a single string:
~s.
It's interpreted as a method body by default.

If you meant this string to be a generic docstring, and not a method
body, add an explicit NIL or some other body form:
(define-generic name (arg1 arg2)
  \"Docstring\"
  'body-form)

If you meant it as a body form, do nothing, or provide explicit
documentation or any other option:
(define-generic name (arg1 arg2)
  \"Docstring\"
  (:documentation \"Real docstring\"))" (first body)))
    (let* ((generic-declarations (remove-if (lambda (d)
                                              (or (> (length d) 2)
                                                  (not (eq 'optimize (first (second d))))
                                                  (notevery (lambda (o)
                                                              (let ((feature (first (uiop:ensure-list o))))
                                                                (or (eq feature 'speed)
                                                                    (eq feature 'space))))
                                                            (rest (second d)))))
                                            declarations))
           (options (remove-if-not (lambda (form)
                                     (keywordp (first (uiop:ensure-list form))))
                                   body))
           (method-body (remove-if (lambda (f) (member f options :test #'equal)) body))
           (export-generic-name-p (find :export-generic-name-p options :key #'first))
           (options (remove export-generic-name-p options :test #'equal))
           (export-p (if export-generic-name-p
                         (second export-generic-name-p)
                         *export-generic-name-p*))
           (generalized-arglist (generalize-arglist arglist)))
      (when (and (not (equal generalized-arglist arglist))
                 (every #'null (list method-body options)))
        (style-warn "Specialized arglist used without method body in define-generic: ~a" arglist))
      `(prog1
           (defgeneric ,name ,generalized-arglist
             ,@generic-declarations
             ,@(when (or method-body
                         (not (equal generic-declarations
                                     declarations)))
                 `((:method ,arglist
                     ,@declarations
                     ,@method-body)))
             ,@options
             ,@(when documentation
                 `((:documentation ,documentation))))
         ;; FIXME: Maybe only export if package of generic function name
         ;; matches *PACKAGE*?
         ,@(when export-p
             `((eval-when (:compile-toplevel :load-toplevel :execute)
                 (export ',name ,(package-name *package*)))))
         ,@(let ((documentation (or documentation
                                    (second (first (member :documentation options :key #'first))))))
             (when documentation
               `((setf (documentation ',name 'function) ,documentation)
                 (setf (documentation (fdefinition ',name) 'function) ,documentation))))))))

(prog1 (defgeneric generic (a b &key &allow-other-keys) (:method ((a a) (b b) &key (c nil) &allow-other-keys) (+ a b))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-value-binding table-keys (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (declare (ignore ,val)) (if ,next (update ,var ,key) (end-for))))

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

Input: (define-value-binding table-keys (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (declare (ignore ,val)) (if ,next (update ,var ,key) (end-for))))

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

(define-direct-binding table-keys (var table) (let ((#:iterator145 (gensym #A((8) base-char . "ITERATOR"))) (#:next146 (gensym #A((4) base-char . "NEXT"))) (#:key147 (gensym #A((3) base-char . "KEY"))) (#:val148 (gensym #A((3) base-char . "VAL"))) (#:table144 (gensym #A((5) base-char . "TABLE")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:table144 table) (list #:iterator145 (list (quote hash-table-iterator) #:table144)) (list #:next146 nil) (list #:key147 nil) (list #:val148 nil) (loop for #:var143 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var143 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:iterator145 :kind 0) #S(sb-impl::comma :expr #:next146 :kind 0) #S(sb-impl::comma :expr #:key147 :kind 0) #S(sb-impl::comma :expr #:val148 :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote hash-table) :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote function) :kind 0) #S(sb-impl::comma :expr #:iterator145 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((iterator #:iterator145) (next #:next146) (key #:key147) (val #:val148) (table #:table144)) (declare (ignorable iterator next key val table)) (sb-int:quasiquote (multiple-value-bind (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr val :kind 0)) (funcall #S(sb-impl::comma :expr iterator :kind 0)) (declare (ignore #S(sb-impl::comma :expr val :kind 0))) (if #S(sb-impl::comma :expr next :kind 0) (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr key :kind 0)) (end-for))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defgenerator cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x)))))

Issue: Macro call that should be transformed by defgenerator

Input: (defgenerator cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x)))))

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

(defun cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (with-yield (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-accumulation-binding minimizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,result) result) ,(if key `(funcall ,key ,var) var))) (setf ,var ,result)))))

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

Input: (define-accumulation-binding minimizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,result) result) ,(if key `(funcall ,key ,var) var))) (setf ,var ,result)))))

Output:
(defmacro define-accumulation-binding (name (var &rest args) &body body)
  `(define-form-binding ,name (,var ,@args)
     ,@(form-fiddle:lambda-declarations `(lambda () ,@body))
     (values
      (progn ,@(form-fiddle:lambda-forms `(lambda () ,@body)))
      (delist var))))

(define-form-binding minimizing (var form &key key) (values (progn (let ((result (gensym "RESULT"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr result :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when (or (not #S(sb-impl::comma :expr var :kind 0)) (< #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr result :kind 0))) result) :kind 0) #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr var :kind 0))) var) :kind 0))) (setf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr result :kind 0))))))) (delist var)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(builder :session (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder '(200 () ("hi")))) (lambda (responder) (funcall responder '(200 () "hi"))))))

Problem: Macro call that should be transformed by builder

Input: (builder :session (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder '(200 () ("hi")))) (lambda (responder) (funcall responder '(200 () "hi"))))))

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 (find-middleware :session))) :initial-value (to-app (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder (quote (200 nil ("hi"))))) (lambda (responder) (funcall responder (quote (200 nil "hi"))))))) :from-end t)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-iter ignored-backing-name (curr-val step) (count (start step) (init-state (curr-val start) step)) (prog1 curr-val (incf curr-val step)))

Problem: Macro call that should be transformed by def-iter

Input: (def-iter ignored-backing-name (curr-val step) (count (start step) (init-state (curr-val start) step)) (prog1 curr-val (incf curr-val step)))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname129 (&key curr-val step) (labels ((self nil (prog1 curr-val (incf curr-val step)))) (function self)))) (defun count (start step) "Function had no docstring, so this one was inserted" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname129)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (curr-val start) step))))