Instruction:
Define a macro that eliminates this repetitive pattern:
(defun/1 pow (x y) (expt x y))

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

Input: (defun/1 pow (x y) (expt x y))

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-mustache-character #\= (let ((arg-text (string-trim '(#\Space #\Tab #\=) arg-text))) (prog1 (make-instance 'delimiter-tag :text arg-text) (change-delimiter arg-text))))

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

Input: (define-mustache-character #\= (let ((arg-text (string-trim '(#\Space #\Tab #\=) arg-text))) (prog1 (make-instance 'delimiter-tag :text arg-text) (change-delimiter arg-text))))

Output:
(defmacro define-mustache-character (char &body body)
  `(set-mustache-character
    ,char (lambda (raw-text arg-text escapep start end)
            (declare (ignorable raw-text arg-text escapep start end)
                     (type simple-string raw-text arg-text)
                     (boolean escapep)
                     (offset start end))
            ,@body)))

(set-mustache-character #\EQUALS_SIGN (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (let ((arg-text (string-trim (quote (#\Space #\Tab #\EQUALS_SIGN)) arg-text))) (prog1 (make-instance (quote delimiter-tag) :text arg-text) (change-delimiter arg-text)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-iter iterator-dropwhile (base-iter pred been-false) (dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (init-state (pred predicate) (base-iter (make-iterator iterable)))) (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values item t))) (values nil nil)))))

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

Input: (def-iter iterator-dropwhile (base-iter pred been-false) (dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (init-state (pred predicate) (base-iter (make-iterator iterable)))) (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values 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-fname138 (&key base-iter pred been-false) (labels ((self nil (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values item t))) (values nil nil)))))) (function self)))) (defun dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname138)) (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 (pred predicate) (base-iter (make-iterator iterable))))))


Instruction:
Generate a defmacro form that transforms code like this:
(check-cursor-attached cluffer:end-of-buffer-p (cursor))

Pattern to recognize: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:end-of-buffer-p (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:end-of-buffer-p :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defdata maybe (just t) nothing)

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

Input: (defdata maybe (just t) nothing)

Output:
(defmacro defdata (adt-name &body constructors)
  "Define a new ADT. ADT-name has the following grammar:

ADT-NAME := <symbol>
          | (<symbol> <options>*)

There is no difference between specifying it as a symbol or as a
singleton list. There are two possible options, specified as a
property list:

    * :MUTABLE {T, NIL} (default: NIL): Specifies whether the fields
      of the type are mutable, allowing the use of SET-DATA.

    * :INCLUDE <adt-type>: Specifies whether another defined ADT
      should be inherited.

Constructors is a list of clauses with the following grammar:

<clause> := <symbol>
          | (<symbol> <type-specifier>*)

Each clause defines a constructor for the ADT. Nullary constructors
will define constants and all other constructors will define
functions."
  ;; Do some extreme sanity checking.
  (assert
   (or
    ;; Must be a symbol, or...
    (symbolp adt-name)
    (and
     ;; a list that is...
     (listp adt-name)
     ;; non-empty
     (not (null adt-name))
     ;; whose first element is a symbol (the name of the adt)
     (symbolp (first adt-name))
     ;; and the rest is a property list
     (property-list-p (rest adt-name))))
   (adt-name)
   "ADT-NAME must either be a symbol, a singleton list with the ADT ~
      name as a symbol, or a list of two elements with the ADT name ~
      and :MUTABLE respectively. Given ~S."
   adt-name)
  (let ((valid-options (list ':mutable ':include)))
    (when (and (listp adt-name) (= (mod (length (rest adt-name)) 2) 0))
      (loop for opt in (rest adt-name) by #'cddr do
	   (when (not (member opt valid-options))
	     (error "Option ~A is not valid, valid options are member of ~A." opt valid-options)))))

  (let ((adt-name (ensure-car adt-name))
        (mutable? (and (listp adt-name)
                       (getf (rest adt-name) ':mutable)
                       t))
        (include (or (and (listp adt-name)
                          (getf (rest adt-name) ':include))
                     'algebraic-data-type))
        (object (gensym "OBJECT-"))
        (stream (gensym "STREAM-"))
        (depth (gensym "DEPTH-"))
        (env (gensym "ENVIRONMENT-"))
        (documentation
          (when (stringp (car constructors))
            (pop constructors))))

    ;; Sanity check that INCLUDE is a proper algebraic data type.
    (assert (algebraic-data-type-p include)
            ()
            "When defining the algebraic data type ~S, the :INCLUDE option ~
             was specified with ~S, which is not another algebraic data ~
             type."
            adt-name
            include)

    ;; Add constructors and their arity to the database.
    (flet ((constructor-and-arity (ctor)
             (if (listp ctor)
                 (list (first ctor) (length (rest ctor)))
                 (list ctor 0))))
      (set-constructors adt-name (append (get-constructors include)
                                         (mapcar #'constructor-and-arity constructors))))

    (flet ((make-printer (name &optional (nfields 0))
             "Make a printer function for the structs."
             `(lambda (,object ,stream ,depth)
                (declare (ignore ,depth)
                         (ignorable ,object))
                ;; We don't check *PRINT-READABLY* because these can
                ;; be readably printed always, provided the arguments
                ;; can be printed readably.
                ;;
                ;; However, we do respect a convenience option
                ;; *PRINT-ADT-READABLY* in case someone finds the
                ;; printing of the #. to be annoying.
                (when *print-adt-readably*
                  (write-string "#." ,stream))
                ,(when (plusp nfields)
                   `(write-char #\( ,stream))
                (prin1 ',name ,stream)
                ,@(when (plusp nfields)
                    (loop :for i :below nfields
                          :append (list
                                   `(write-char #\Space ,stream)
                                   `(prin1 (,(field name i) ,object)
                                           ,stream))))
                ,(when (plusp nfields)
                   `(write-char #\) ,stream)))))
      ;; Define everything.
      (let ((component-documentation
             ;; Force the adt-name symbol to print with a package
             ;; prefix
             (let ((*package* (find-package :keyword)))
               (format nil "A component of ADT ~S" adt-name))))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
           ;; Define the data type.
           (defstruct (,adt-name (:constructor nil)
                                 (:copier nil)
                                 (:predicate nil)
                                 (:include ,include))
             ,@(unsplice documentation))

           ;; Define each of the field constructors.
           ,@(loop :for ctor :in (unwrap-singletons constructors)
                   :collect
                   (etypecase ctor
                     ;; Nullary constructor
                     (symbol `(progn
                                (eval-when (:compile-toplevel :load-toplevel :execute)
                                  (defstruct
                                      (,ctor
                                       (:include ,adt-name)
                                       (:constructor ,(internal ctor))
                                       (:copier nil)
                                       (:predicate nil)
                                       (:print-function ,(make-printer ctor)))
                                    ,component-documentation))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor))
                                (defmethod make-load-form ((,object ,ctor) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names nil
                                                               :environment ,env))
                                (define-constant ,ctor (,(internal ctor))
                                  ,component-documentation)
                                (fmakunbound ',(internal ctor))))

                     ;; N-ary constructors
                     (list (let* ((ctor-name (first ctor))
                                  (field-types (rest ctor))
                                  (field-names (gen-names (length field-types))))
                             `(progn
                                (defstruct (,ctor-name
                                            (:include ,adt-name)
                                            (:constructor ,ctor-name (,@field-names))
                                            (:conc-name ,ctor-name)
                                            (:copier nil)
                                            (:predicate nil)
                                            (:print-function
                                             ,(make-printer ctor-name
                                                            (length field-names))))
                                  ,component-documentation
                                  ,@(mapcar (lambda (name type)
                                              `(,name (error "Unspecified field.")
                                                      :type ,type
                                                      ,@(if mutable?
                                                            nil
                                                            '(:read-only t))))
                                     field-names
                                     field-types))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor-name))
                                (defmethod make-load-form ((,object ,ctor-name) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names ',field-names
                                                               :environment ,env)))))))
           ;; Return the type name
           ',adt-name)))))

(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (maybe (:constructor nil) (:copier nil) (:predicate nil) (:include algebraic-data-type))) (progn (defstruct (just (:include maybe) (:constructor just (%0)) (:conc-name just) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-133 #:stream-134 #:depth-135) (declare (ignore #:depth-135) (ignorable #:object-133)) (when *print-adt-readably* (write-string "#." #:stream-134)) (write-char #\LEFT_PARENTHESIS #:stream-134) (prin1 (quote just) #:stream-134) (write-char #\Space #:stream-134) (prin1 (just%0 #:object-133) #:stream-134) (write-char #\RIGHT_PARENTHESIS #:stream-134)))) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE") (%0 (error "Unspecified field.") :type t :read-only t)) (declaim (sb-ext:freeze-type just)) (defmethod make-load-form ((#:object-133 just) &optional #:environment-136) (make-load-form-saving-slots #:object-133 :slot-names (quote (%0)) :environment #:environment-136))) (progn (eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (nothing (:include maybe) (:constructor %nothing) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-133 #:stream-134 #:depth-135) (declare (ignore #:depth-135) (ignorable #:object-133)) (when *print-adt-readably* (write-string "#." #:stream-134)) nil (prin1 (quote nothing) #:stream-134) nil))) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE"))) (declaim (sb-ext:freeze-type nothing)) (defmethod make-load-form ((#:object-133 nothing) &optional #:environment-136) (make-load-form-saving-slots #:object-133 :slot-names nil :environment #:environment-136)) (define-constant nothing (%nothing) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE")) (fmakunbound (quote %nothing))) (quote maybe))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors-read-only a c e) obj)) (setf a :a c :c) (ensure-same (list a c e) '(:a :c 5) :test 'equal) (ensure-same (list (e obj) (c obj) (a obj)) '(5 3 1) :test 'equal))

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

Input: (bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors-read-only a c e) obj)) (setf a :a c :c) (ensure-same (list a c e) '(:a :c 5) :test 'equal) (ensure-same (list (e obj) (c obj) (a obj)) '(5 3 1) :test 'equal))

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

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

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

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

(let* ((obj (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (#:|values-174| obj) (a (a #:|values-174|)) (c (c #:|values-174|)) (e (e #:|values-174|))) (declare (ignorable #:|values-174|)) (progn (setf a :a c :c) (ensure-same (list a c e) (quote (:a :c 5)) :test (quote equal)) (ensure-same (list (e obj) (c obj) (a obj)) (quote (5 3 1)) :test (quote equal))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(signal-reader-error "Expected } after Unicode character name")

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

Input: (signal-reader-error "Expected } after Unicode character name")

Output:
(defmacro signal-reader-error (format-control &rest format-arguments)
  "Like ERROR but signals a SIMPLE-READER-ERROR for the stream
*STREAM*."
  `(error 'simple-reader-error
          :stream *stream*
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

(error (quote simple-reader-error) :stream *stream* :format-control "Expected } after Unicode character name" :format-arguments (list))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(fail (warn "An expected warning.") warning)

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

Input: (fail (warn "An expected warning.") warning)

Output:
(defmacro fail (form &optional (type 'error) description &rest format-args)
  `(eval-in-context
    *context*
    (make-instance 'comparison-result
                   :expression '(fail ,form ,type)
                   :value-form '(capture-error ,form)
                   :body (lambda () (capture-error ,form ,(maybe-unquote type)))
                   :expected ',(maybe-unquote type)
                   :comparison 'typep
                   ,@(when description
                       `(:description (format NIL ,description ,@format-args))))))

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (fail (warn "An expected warning.") warning)) :value-form (quote (capture-error (warn "An expected warning."))) :body (lambda nil (capture-error (warn "An expected warning.") warning)) :expected (quote warning) :comparison (quote typep)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(def-iter iterator-combinations (indices pool stopped r n) (combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))

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

Input: (def-iter iterator-combinations (indices pool stopped r n) (combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))

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

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

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

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

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

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

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

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

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

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

(labels ((#:next-fname128 (&key indices pool stopped r n) (labels ((self nil (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))) (function self)))) (defun combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname128)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1)))))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(assert-values ("changed foo = 1") (foo 1) (foo+1 2) (bar 2) (bar-1 1))

Write a macro that addresses: Macro call that should be transformed by assert-values

Input: (assert-values ("changed foo = 1") (foo 1) (foo+1 2) (bar 2) (bar-1 1))

Output:
(defmacro assert-values ((desc) &body objects-and-values)
  `(progn
     (trc ,desc)
     ,@(loop for (obj val) in objects-and-values
	    collect `(assert (eql (value ,obj) ,val)))))

(progn (trc "changed foo = 1") (assert (eql (value foo) 1)) (assert (eql (value foo+1) 2)) (assert (eql (value bar) 2)) (assert (eql (value bar-1) 1)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when (or (typep (node-slot expression) 'function-call) (typep (node-slot expression) 'infix-expression) (typep (node-slot expression) 'prefix-expression) (typep (node-slot expression) 'postfix-expression) (typep (node-slot expression) 'empty) (node-slot force-semicolon)) (format stream ";"))

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

Input: (when (or (typep (node-slot expression) 'function-call) (typep (node-slot expression) 'infix-expression) (typep (node-slot expression) 'prefix-expression) (typep (node-slot expression) 'postfix-expression) (typep (node-slot expression) 'empty) (node-slot force-semicolon)) (format stream ";"))

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

(if (or (typep (node-slot expression) (quote function-call)) (typep (node-slot expression) (quote infix-expression)) (typep (node-slot expression) (quote prefix-expression)) (typep (node-slot expression) (quote postfix-expression)) (typep (node-slot expression) (quote empty)) (node-slot force-semicolon)) (format stream ";"))


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

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

Input: (continue-whopper nil :key nil)

Output: (defmacro CONTINUE-WHOPPER ...)

(call-next-method-fn self class-env inst-env mcs%caller mcs%next-methods
                     (list nil :key nil))


Instruction:
Generate a defmacro form that transforms code like this:
(draw scene (:rect :x 30 :y 30 :width 400 :height 150) :fill "rgb(230,230,230)" :stroke "black")

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

Input: (draw scene (:rect :x 30 :y 30 :width 400 :height 150) :fill "rgb(230,230,230)" :stroke "black")

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

(let ((#:g164 (funcall (function make-svg-element) :rect (append (list :x 30 :y 30 :width 400 :height 150) (list :fill "rgb(230,230,230)" :stroke "black"))))) (add-element scene #:g164) #:g164)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(letrec* (x) x)

Problem: Macro call that should be transformed by letrec*

Input: (letrec* (x) x)

Output:
(defmacro letrec* ((&rest bindings) &body body)
  "Like LETREC, but the bindings are evaluated in order.
See Waddell et al., *Fixing Letrec* for motivation.

Cf. `fbindrec*'."
  `(letrec-with setq ,bindings
     ,@body))


Instruction:
Define a macro that eliminates this repetitive pattern:
(alist-bind (name type) form (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) `(define-foreign-extern ',sym ,name ',@(parse-type type (aval :tag type)))))

Issue: Macro call that should be transformed by alist-bind

Input: (alist-bind (name type) form (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) `(define-foreign-extern ',sym ,name ',@(parse-type type (aval :tag type)))))

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 ((#:alist246 form)) (let ((name (aval :name #:alist246)) (type (aval :type #:alist246))) (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) (sb-int:quasiquote (define-foreign-extern (quote #S(sb-impl::comma :expr sym :kind 0)) #S(sb-impl::comma :expr name :kind 0) (quote #S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2)))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-simple-type-map variable cl:variable)

Issue: Macro call that should be transformed by define-simple-type-map

Input: (define-simple-type-map variable cl:variable)

Output:
(defmacro define-simple-type-map (class type)
  `(defmethod type ((,class ,class))
     ',type))

(defmethod type ((variable variable)) (quote common-lisp:variable))


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

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

Input: (undefmessage 'some-name)

Output: (defmacro UNDEFMESSAGE ...)


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

Issue: Macro call that should be transformed by ->

Input:
(->
  'some-name)

Output: (defmacro -> ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym multiplying :mult)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym multiplying :mult)

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

(eval-always (setf (get (quote multiplying) (quote synonym)) (quote :mult)))


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

Write a macro that addresses: Macro call that should be transformed by NEXT-IN

Input: (next-in nil :key nil)

Output: (defmacro NEXT-IN ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-table-name nil (yield obj))

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

Input: (with-table-name nil (yield obj))

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

(let ((*table-name-scope* nil)) (yield obj))


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

Issue: Macro call that should be transformed by DECF

Input: (decf nil nil)

Output: (defmacro DECF ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(read-char*)

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

Input: (read-char*)

Output:
(defmacro read-char* ()
  "Convenience macro because we always read from the same string with
the same arguments."
  `(read-char *stream* t nil t))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause (sum expr &optional into var result-type (type 'number)) "Sum into a variable" (return-reduction-code :identity 0 :operation '+ :expression expr :test nil :variable var :type type :accum-kind :increment))

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

Input: (defclause (sum expr &optional into var result-type (type 'number)) "Sum into a variable" (return-reduction-code :identity 0 :operation '+ :expression expr :test nil :variable var :type type :accum-kind :increment))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-sum-10 (&key ((:sum expr)) ((:into var)) ((:result-type type) (quote number))) "Sum into a variable" (return-reduction-code :identity 0 :operation (quote +) :expression expr :test nil :variable var :type type :accum-kind :increment)) (install-clause-info (quote (sum)) (quote (sum &optional :into :result-type)) (quote clause-sum-10) "Sum into a variable" nil) (quote (sum expr &optional into var result-type (type (quote number)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form 'multiple-value-call-nondeterministic) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (rest form)))) (funcall map-function form 'multiple-value-call-nondeterministic)))

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

Input: (defun-compile-time walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form 'multiple-value-call-nondeterministic) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (rest form)))) (funcall map-function form 'multiple-value-call-nondeterministic)))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form (quote multiple-value-call-nondeterministic)) (reduce reduce-function (mapcar (function (lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment))) (rest form)))) (funcall map-function form (quote multiple-value-call-nondeterministic)))) (eval-when (:compile-toplevel) (compile (quote walk-multiple-value-call-nondeterministic))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-table node hash depth (bitmap array bits index hit) (if hit (%hamt-lookup (aref array index) key hash (1+ depth) test) (values nil nil)))

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

Input: (with-table node hash depth (bitmap array bits index hit) (if hit (%hamt-lookup (aref array index) key hash (1+ depth) test) (values nil nil)))

Output:
(defmacro with-table (node hash depth
                      (bitmap array bits index hit)
                      &body body)
  "Bitshifting in HAMT tables"
  `(let* ((,bitmap (table-bitmap ,node))
          (,array (table-array ,node))
          (,bits (get-bits ,hash ,depth))
          (,index (get-index ,bits ,bitmap))
          (,hit (logbitp ,bits ,bitmap)))
     ,@body))

(let* ((bitmap (table-bitmap node)) (array (table-array node)) (bits (get-bits hash depth)) (index (get-index bits bitmap)) (hit (logbitp bits bitmap))) (if hit (%hamt-lookup (aref array index) key hash (1+ depth) test) (values nil nil)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-match node) (multiple-value-bind (new-node new-changed?) (maybe-simplify-match node) (when new-changed? (setf changed? t) new-node)))

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

Input: (action (:after node-match node) (multiple-value-bind (new-node new-changed?) (maybe-simplify-match node) (when new-changed? (setf changed? t) new-node)))

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-match) (lambda (node) (declare (type node-match node)) (multiple-value-bind (new-node new-changed?) (maybe-simplify-match node) (when new-changed? (setf changed? t) new-node))))


Instruction:
Generate a defmacro form that transforms code like this:
(do-for nil
  nil)

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

Input:
(do-for nil
  nil)

Output: (defmacro DO-FOR ...)

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


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

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

Input: (-> :three () (increment))

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


Instruction:
Generate a defmacro form that transforms code like this:
(set-handler nil :key nil)

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

Input: (set-handler nil :key nil)

Output: (defmacro SET-HANDLER ...)

(let ((key :key) (function nil))
  (let ((found (assoc key nil :test #'equal)))
    (if found
        (setf (cdr found) function)
        (prog1 function (push (cons key function) nil)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'make-accumulator :array-element #'accumulator-add :end-of-array #'accumulator-get-sequence :beginning-of-object #'make-accumulator :object-key #'accumulator-add-key :object-value #'accumulator-add-value :end-of-object #'accumulator-get :beginning-of-string #'make-vector-accumulator :string-char #'vector-accumulator-add :end-of-string #'vector-accumulator-get-string)

Issue: Macro call that should be transformed by set-custom-vars

Input: (set-custom-vars :integer #'parse-number :real #'parse-number :boolean #'json-boolean-to-lisp :beginning-of-array #'make-accumulator :array-element #'accumulator-add :end-of-array #'accumulator-get-sequence :beginning-of-object #'make-accumulator :object-key #'accumulator-add-key :object-value #'accumulator-add-value :end-of-object #'accumulator-get :beginning-of-string #'make-vector-accumulator :string-char #'vector-accumulator-add :end-of-string #'vector-accumulator-get-string)

Output:
(defmacro set-custom-vars (&rest key-args)
  `(setq
    ,@(loop for (supplied-key value) on key-args by #'cddr
         append (loop for (var . var-key) in *custom-vars*
                   thereis (if (eql var-key supplied-key)
                               (list var value))))))

(setq *integer-handler* (function parse-number) *real-handler* (function parse-number) *boolean-handler* (function json-boolean-to-lisp) *beginning-of-array-handler* (function make-accumulator) *end-of-array-handler* (function accumulator-get-sequence) *beginning-of-object-handler* (function make-accumulator) *object-key-handler* (function accumulator-add-key) *object-value-handler* (function accumulator-add-value) *end-of-object-handler* (function accumulator-get) *beginning-of-string-handler* (function make-vector-accumulator) *string-char-handler* (function vector-accumulator-add) *end-of-string-handler* (function vector-accumulator-get-string))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defstore example (&key (a 0) (b 0) (c (the integer (init-c a b)))))

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

Input: (defstore example (&key (a 0) (b 0) (c (the integer (init-c a b)))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (defun a-init-function152 (a #:a?163 b #:b?164) (declare (ignorable a #:a?163 b #:b?164)) (the integer (init-c a b))) (ensure-store (quote example) (quote (&key (a 0 #:a?163) (b 0 #:b?164) (c (the integer (a-init-function152 a #:a?163 b #:b?164)) #:c?165))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn (format nil "SHOW CREATE VIEW `~A`" table-name)) (let ((results (dbi:execute query))) (getf (first (dbi:fetch-all results :format :plist)) :|Create View|)))

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

Input: (with-prepared-query query (conn (format nil "SHOW CREATE VIEW `~A`" table-name)) (let ((results (dbi:execute query))) (getf (first (dbi:fetch-all results :format :plist)) :|Create View|)))

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

(call-with-prepared-query conn (format nil "SHOW CREATE VIEW `~A`" table-name) (lambda (query) (let ((results (dbi.driver:execute query))) (getf (first (dbi.driver:fetch-all results :format :plist)) :|Create View|))) :use-prepare-cached nil)


Instruction:
Define a macro that eliminates this repetitive pattern:
(when else-body `(make-simple-block ,else-body))

Issue: Macro call that should be transformed by when

Input: (when else-body `(make-simple-block ,else-body))

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

(if else-body (sb-int:quasiquote (make-simple-block #S(sb-impl::comma :expr else-body :kind 0))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-case-aware-find-symbol find-pragma-name #:with-c-syntax.pragma-name)

Pattern to recognize: Macro call that should be transformed by define-case-aware-find-symbol

Input: (define-case-aware-find-symbol find-pragma-name #:with-c-syntax.pragma-name)

Output:
(defmacro define-case-aware-find-symbol
    (finder-function-name package-name
     &key (upcased-package-name (format nil "~A.~A" (string package-name) '#:UPCASED))
       (docstring
        (format nil "Find a symbol in `~A' package having a same NAME. If not found, returns `nil'."
                package-name)))
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defpackage ,upcased-package-name
       (:use)
       (:intern
        ,@(loop for sym being the external-symbol of package-name
                collect (string-upcase (symbol-name sym)))))
     ,@(loop for sym being the external-symbol of package-name
             for upcased = (string-upcase (symbol-name sym))
             collect `(setf (symbol-value (find-symbol ,upcased ',upcased-package-name))
                            ',sym))
     (defun ,finder-function-name (string &optional (readtable-case (readtable-case *readtable*)))
       ,@(if docstring `(,docstring))
       (ecase readtable-case
         ((:upcase :invert)
          (if-let ((up-sym (find-symbol string ',upcased-package-name)))
            (symbol-value up-sym)))
         ((:downcase :preserve)
          (find-symbol string ',package-name))))))

(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED") (:use) (:intern #A((4) base-char . "STDC") #A((4) base-char . "ONCE") #A((13) base-char . "WITH_C_SYNTAX"))) (setf (symbol-value (find-symbol #A((4) base-char . "STDC") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:stdc)) (setf (symbol-value (find-symbol #A((4) base-char . "ONCE") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:|once|)) (setf (symbol-value (find-symbol #A((13) base-char . "WITH_C_SYNTAX") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:with_c_syntax)) (defun find-pragma-name (string &optional (readtable-case (readtable-case *readtable*))) #A((101) base-char . "Find a symbol in `WITH-C-SYNTAX.PRAGMA-NAME' package having a same NAME. If not found, returns `nil'.") (ecase readtable-case ((:upcase :invert) (if-let ((up-sym (find-symbol string (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED"))))) (symbol-value up-sym))) ((:downcase :preserve) (find-symbol string (quote #:with-c-syntax.pragma-name))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do-files (file (app-path "themes/") "tmpl") (compile-template :common-lisp-backend file))

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

Input: (do-files (file (app-path "themes/") "tmpl") (compile-template :common-lisp-backend file))

Output:
(defmacro do-files ((var path &optional extension) &body body)
  "For each file under PATH, run BODY. If EXTENSION is provided, only run
BODY on files that match the given extension."
  (alexandria:with-gensyms (extension-p)
    `(flet ((,extension-p (file)
              (string= (pathname-type file) ,extension)))
       (cl-fad:walk-directory ,path (lambda (,var) ,@body)
                              :follow-symlinks nil
                              :test (if ,extension
                                        #',extension-p
                                        (constantly t))))))

(flet ((#:extension-p289 (file) (string= (pathname-type file) "tmpl"))) (cl-fad:walk-directory (app-path "themes/") (lambda (file) (compile-template :common-lisp-backend file)) :follow-symlinks nil :test (if "tmpl" (function #:extension-p289) (constantly t))))


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

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

Input: (true 5)

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (true 5)) :value-form (quote 5) :body (lambda nil 5) :expected (quote t) :comparison (quote geq)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause (multiply expr &optional into var result-type (type 'number)) "Multiply into a variable" (return-reduction-code :identity 1 :operation '* :expression expr :test nil :variable var :type type :accum-kind :increment))

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

Input: (defclause (multiply expr &optional into var result-type (type 'number)) "Multiply into a variable" (return-reduction-code :identity 1 :operation '* :expression expr :test nil :variable var :type type :accum-kind :increment))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-multiply-11 (&key ((:multiply expr)) ((:into var)) ((:result-type type) (quote number))) "Multiply into a variable" (return-reduction-code :identity 1 :operation (quote *) :expression expr :test nil :variable var :type type :accum-kind :increment)) (install-clause-info (quote (multiply)) (quote (multiply &optional :into :result-type)) (quote clause-multiply-11) "Multiply into a variable" nil) (quote (multiply expr &optional into var result-type (type (quote number)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-wcs-math-error-handling (ret (atanh x)) (check-wcs-math-result))

Problem: Macro call that should be transformed by with-wcs-math-error-handling

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


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

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

Input:
(->*
  nil
  :key
  nil)

Output: (defmacro ->* ...)


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

Problem: Macro call that should be transformed by LET+

Input: (let+ nil)

Output: (defmacro LET+ ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(fmap #'nreverse (recurse (list res) next))

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

Input: (fmap #'nreverse (recurse (list res) next))

Output:
(defmacro fmap (f thing)
  "Apply a pure function to the inner contents of some parsing operation, if the
parsing itself was successful."
  `(multiple-value-bind (res next) ,thing
     (if (failure? res)
         (fail next)
         (values (funcall ,f res) next))))

(multiple-value-bind (res next) (recurse (list res) next) (if (failure? res) (fail next) (values (funcall (function nreverse) res) next)))


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

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

Input: (some-> nil (progn))

Output: (defmacro SOME-> ...)


Instruction:
Generate a defmacro form that transforms code like this:
(setypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))

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

Input: (setypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))

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

(symbolic etypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))


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

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

Input:
(iterate
  nil
  (progn))

Output: (defmacro ITERATE ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(sif 1 (aif it it))

Issue: Macro call that should be transformed by sif

Input: (sif 1 (aif it it))

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lambda-match0 ((list* 'guard1 _) t))

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

Input: (lambda-match0 ((list* 'guard1 _) t))

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

(lambda (#:arg164) (match0 #:arg164 ((list* (quote guard1) _) t)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-transaction *db* (commit *db*) (setf value :foo))

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

Input: (with-transaction *db* (commit *db*) (setf value :foo))

Output:
(defmacro with-transaction (conn &body body)
  "Start a transaction and commit at the end of this block. If the evaluation `body` is interrupted, the transaction is rolled back automatically."
  (let ((conn-var (gensym "CONN-VAR")))
    `(let ((,conn-var ,conn))
       (if (in-transaction ,conn-var)
           (with-savepoint ,conn-var ,@body)
           (%with-transaction ,conn-var ,@body)))))

(let ((#:conn-var161 *db*)) (if (in-transaction #:conn-var161) (with-savepoint #:conn-var161 (commit *db*) (setf value :foo)) (%with-transaction #:conn-var161 (commit *db*) (setf value :foo))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(maybe-once-only nil
  :key
  nil)

Write a macro that addresses: Macro call that should be transformed by MAYBE-ONCE-ONLY

Input:
(maybe-once-only nil
  :key
  nil)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms))

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

Input: (defclause finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms))

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

(progn (defmacro finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms)) (pushnew (quote finally) *clauses*))


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

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

Input:
(sum-of nil
  :key
  nil)

Output: (defmacro SUM-OF ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(deferror "42701" duplicate-column syntax-error-or-access-violation)

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

Input: (deferror "42701" duplicate-column syntax-error-or-access-violation)

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

(progn (define-condition duplicate-column (syntax-error-or-access-violation) nil) (setf (gethash "42701" *error-table*) (quote duplicate-column)))


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

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

Input: (cond-> nil (progn))

Output: (defmacro COND-> ...)


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

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

Input: (in-compile-time nil)

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

(macrolet ((#:macro141 (&environment ())
             ))
  (#:macro141))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (not (or (eql (top-info) 'typedef) (eql (top-info) 'decl))) (format stream ";"))

Problem: Macro call that should be transformed by when

Input: (when (not (or (eql (top-info) 'typedef) (eql (top-info) 'decl))) (format stream ";"))

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

(if (not (or (eql (top-info) (quote typedef)) (eql (top-info) (quote decl)))) (format stream ";"))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-neo4j-fun get-node-properties (node-id) :get (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (200 (decode-neo4j-json-output body)) (204 nil) (404 (error 'node-not-found-error :uri uri))))

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

Input: (def-neo4j-fun get-node-properties (node-id) :get (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (200 (decode-neo4j-json-output body)) (204 nil) (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-properties (&key node-id) (let ((uri (format nil "node/~A/properties" node-id)) (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 204 (lambda (body uri json) nil)) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


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

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

Input: (lambda ())

Output: (defmacro LAMBDA ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(gen-lambda-with-sticky-stop () (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply #'values (nreverse tmp))))

What needs to change: Macro call that should be transformed by gen-lambda-with-sticky-stop

Input: (gen-lambda-with-sticky-stop () (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply #'values (nreverse tmp))))

Output:
(defmacro gen-lambda-with-sticky-stop (&rest rest)
  `(make-instance
    'basic-generator
    :function (sticky-stop-lambda ,@rest)))

(make-instance (quote basic-generator) :function (sticky-stop-lambda nil (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply (function values) (nreverse tmp)))))


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

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

Input: (send nil :key nil)

Output: (defmacro SEND ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-wcs-math-error-handling (ret (ftruncate x)) (check-wcs-math-result))

Issue: Macro call that should be transformed by with-wcs-math-error-handling

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error* (car this-last-pos) "Quantifier '~A' not allowed." (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer)))

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

Input: (signal-syntax-error* (car this-last-pos) "Quantifier '~A' not allowed." (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer)))

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 (car this-last-pos) :format-control "Quantifier '~A' not allowed." :format-arguments (list (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer))))


Instruction:
Generate a defmacro form that transforms code like this:
(without-symbol-access)

Pattern to recognize: Macro call that should be transformed by WITHOUT-SYMBOL-ACCESS

Input: (without-symbol-access)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (and (not (eql (top-info) 'decl)) (> (length (slot-value (node-slot members) 'nodes)) 3)) (push-sign 'enum-break))

Problem: Macro call that should be transformed by when

Input: (when (and (not (eql (top-info) 'decl)) (> (length (slot-value (node-slot members) 'nodes)) 3)) (push-sign 'enum-break))

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

(if (and (not (eql (top-info) (quote decl))) (> (length (slot-value (node-slot members) (quote nodes))) 3)) (push-sign (quote enum-break)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause in-list (&whole form list &key (by '(function cdr)) (rest (gensym "REST")) &environment env) "Like IN, but specialized for lists. Successive lists are obtained by calling the function BY (which by default is #'CDR) on the previous list. REST, if specified, is the variable holding the remaining elements to be processed; REST initially is bound to the entire list, then to successive lists obtained by funcalling BY." (if (symbolp *iteration-variable*) (list (make-simple-iteration :var rest :init list :step `(funcall ,by ,rest)) (make-simple-iteration :init `(car ,rest) :step `(car ,rest) :precondition `(not (null ,rest)))) (expand-with-simple-destructuring form env)))

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

Input: (defclause in-list (&whole form list &key (by '(function cdr)) (rest (gensym "REST")) &environment env) "Like IN, but specialized for lists. Successive lists are obtained by calling the function BY (which by default is #'CDR) on the previous list. REST, if specified, is the variable holding the remaining elements to be processed; REST initially is bound to the entire list, then to successive lists obtained by funcalling BY." (if (symbolp *iteration-variable*) (list (make-simple-iteration :var rest :init list :step `(funcall ,by ,rest)) (make-simple-iteration :init `(car ,rest) :step `(car ,rest) :precondition `(not (null ,rest)))) (expand-with-simple-destructuring form env)))

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

(progn (defmacro in-list (&whole form list &key (by (quote (function cdr))) (rest (gensym "REST")) &environment env) "Like IN, but specialized for lists. Successive lists are obtained by calling the function BY (which by default is #'CDR) on the previous list. REST, if specified, is the variable holding the remaining elements to be processed; REST initially is bound to the entire list, then to successive lists obtained by funcalling BY." (if (symbolp *iteration-variable*) (list (make-simple-iteration :var rest :init list :step (sb-int:quasiquote (funcall #S(sb-impl::comma :expr by :kind 0) #S(sb-impl::comma :expr rest :kind 0)))) (make-simple-iteration :init (sb-int:quasiquote (car #S(sb-impl::comma :expr rest :kind 0))) :step (sb-int:quasiquote (car #S(sb-impl::comma :expr rest :kind 0))) :precondition (sb-int:quasiquote (not (null #S(sb-impl::comma :expr rest :kind 0)))))) (expand-with-simple-destructuring form env))) (pushnew (quote in-list) *clauses*))


Instruction:
Generate a defmacro form that transforms code like this:
(yield-all g)

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

Input: (yield-all g)

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

(do-generator (#:g182 g) (yield #:g182))


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

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

Input: (define-op (:% conjunctive-op))

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

(defstruct (%-op (:include conjunctive-op (name "%")) (:constructor make-%-op (&rest expressions))))


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

Write a macro that addresses: Macro call that should be transformed by DO-FOR

Input: (do-for nil)

Output: (defmacro DO-FOR ...)

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(is-traced$method 'some-name)

Issue: Macro call that should be transformed by IS-TRACED$METHOD

Input: (is-traced$method 'some-name)

Output: (defmacro IS-TRACED$METHOD ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym counting :count)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym counting :count)

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

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


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

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

Input:
(with-yield
  nil
  nil)

Output: (defmacro WITH-YIELD ...)

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


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

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

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym first-time-p :first-time-p)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym first-time-p :first-time-p)

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

(eval-always (setf (get (quote first-time-p) (quote synonym)) (quote :first-time-p)))


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

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

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

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-definition-resolver setf-expander (designator) (sb-int:info :setf :expander designator))

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

Input: (define-simple-definition-resolver setf-expander (designator) (sb-int:info :setf :expander designator))

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

(define-definition-resolver setf-expander (setf-expander #:package142) (when (ignore-errors (let ((designator setf-expander)) (sb-int:info :setf :expander designator))) (list (make-instance (quote setf-expander) :designator setf-expander :package #:package142))))


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

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

Input:
(lambda-match
  nil
  (progn))

Output: (defmacro LAMBDA-MATCH ...)

(lambda (#:arg148)
  (match #:arg148
    nil
    (progn)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-prepared-query query (conn sql) (or (dbi:fetch-all (dbi:execute query) :format :plist) (error "Table \"~A\" doesn't exist." table-name)))

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

Input: (with-prepared-query query (conn sql) (or (dbi:fetch-all (dbi:execute query) :format :plist) (error "Table \"~A\" doesn't exist." table-name)))

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

(call-with-prepared-query conn sql (lambda (query) (or (dbi.driver:fetch-all (dbi.driver:execute query) :format :plist) (error "Table \"~A\" doesn't exist." table-name))) :use-prepare-cached nil)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-form-html-output (apply #'forms::renderer-render-form-errors renderer theme form args) (:form :id (forms::form-id form) :action (forms::form-action form) :method (symbol-name (forms::form-method form)) :enctype (forms::form-enctype form) :class (getf args :class) :data-parsley-validate (when (forms::client-validation form) "true") (when (forms::form-csrf-protection-p form) (let ((token (forms::set-form-session-csrf-token form))) (htm (:input :name (forms::form-csrf-field-name form) :type "hidden" :value token)))) (loop for field in (forms::form-fields form) do (forms::renderer-render-field renderer theme (cdr field) form))))

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

Input: (with-form-html-output (apply #'forms::renderer-render-form-errors renderer theme form args) (:form :id (forms::form-id form) :action (forms::form-action form) :method (symbol-name (forms::form-method form)) :enctype (forms::form-enctype form) :class (getf args :class) :data-parsley-validate (when (forms::client-validation form) "true") (when (forms::form-csrf-protection-p form) (let ((token (forms::set-form-session-csrf-token form))) (htm (:input :name (forms::form-csrf-field-name form) :type "hidden" :value token)))) (loop for field in (forms::form-fields form) do (forms::renderer-render-field renderer theme (cdr field) form))))

Output:
(defmacro with-form (form &body body)
  "Bind *FORM* to FORM and evaluate BODY in that context."
  `(call-with-form ,form (lambda () ,@body)))

(with-form-html-output (apply (function renderer-render-form-errors) renderer theme form args) (:form :id (form-id form) :action (form-action form) :method (symbol-name (form-method form)) :enctype (form-enctype form) :class (getf args :class) :data-parsley-validate (when (client-validation form) "true") (when (form-csrf-protection-p form) (let ((token (set-form-session-csrf-token form))) (htm (:input :name (form-csrf-field-name form) :type "hidden" :value token)))) (loop for field in (form-fields form) do (renderer-render-field renderer theme (cdr field) form))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-html-string (:div (:div (:div (:div.list-group.toc-entries :data-instant t)))))

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

Input: (with-html-string (:div (:div (:div (:div.list-group.toc-entries :data-instant t)))))

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

(with-output-to-string (*html*) (with-html (:div (:div (:div (:div.list-group.toc-entries :data-instant t))))))


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

Problem: Macro call that should be transformed by COLLECT-PLIST

Input: (collect-plist nil (progn))

Output: (defmacro COLLECT-PLIST ...)

(common-lisp:let* ((#:generator-200 (generator (progn)))
                   #:values-193
                   (#:generator-198 (generator nil))
                   #:indicators-192
                   (#:plist-194 nil))
  (declare (type generator #:generator-200)
           (type generator #:generator-198)
           (type list #:plist-194))
  (tagbody
   #:ll-201
    (setq #:values-193 (next-in #:generator-200 (go end)))
    (setq #:indicators-192 (next-in #:generator-198 (go end)))
    (setq #:plist-194 (list* #:indicators-192 #:values-193 #:plist-194))
    (go #:ll-201)
   end)
  #:plist-194)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-error uniform-in-sfunc () (func-name) "Must not have uniforms in shader functions, only appropriate in shader stages: ~a" func-name)

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

Input: (define-error uniform-in-sfunc () (func-name) "Must not have uniforms in shader functions, only appropriate in shader stages: ~a" func-name)

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

(defcondition uniform-in-sfunc (:error-type varjo-error :prefix "Varjo") (func-name) "Must not have uniforms in shader functions, only appropriate in shader stages: ~a" func-name)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(atypecase "Foo" (fixnum :no) (hash-table :nono))

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

Input: (atypecase "Foo" (fixnum :no) (hash-table :nono))

Output:
(defmacro atypecase (keyform &body cases)
  "Like TYPECASE, except binds the result of the keyform to IT (via LET) for
the scope of the cases."
  `(anaphoric typecase ,keyform ,@cases))

(anaphoric typecase "Foo" (fixnum :no) (hash-table :nono))


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

Issue: Macro call that should be transformed by DEFMETHOD*

Input:
(defmethod* nil
    (progn))

Output: (defmacro DEFMETHOD* ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-env (setp 3 [plist :e]))

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

Input: (with-env (setp 3 [plist :e]))

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(lret* ((type `(integer ,start (,end))) (len (ceiling (- end start) step)) (vector (make-array len :element-type type :initial-element start))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (+ n step))))))

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

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

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

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

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

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

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

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

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

(lret-aux let* ((type (sb-int:quasiquote (integer #S(sb-impl::comma :expr start :kind 0) (#S(sb-impl::comma :expr end :kind 0))))) (len (ceiling (- end start) step)) (vector (make-array len :element-type type :initial-element start))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (+ n step))))))


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

Issue: Macro call that should be transformed by WITH-LOCAL-READTABLE

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

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

(bind ((*readtable* (copy-readtable *readtable*)))
  nil
  :key
  nil)


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

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

Input: (*> +period+ +skip-junk+)

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 (#:*>-offset227) (multiple-value-bind (#:*>-res228 #:*>-next229) (funcall +period+ #:*>-offset227) (if (ok? #:*>-res228) (funcall +skip-junk+ #:*>-next229) (fail #:*>-next229))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(is (characterp c))

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

Input: (is (characterp c))

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

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

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

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

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

(let ((#:v252 c)) (if (characterp #:v252) (add-result (quote test-passed) :test-expr (quote (characterp c))) (process-failure (quote (characterp c)) "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%" (quote c) #:v252 (quote characterp))))