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

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

(with-packages-unlocked nil)

[Assistant]
(defmacro WITH-PACKAGES-UNLOCKED ...)

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


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

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

(fgather-next nil (progn))

[Assistant]
(defmacro FGATHER-NEXT ...)

;; macroexpand:
(nil (progn) nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defun nil ())

Problem: Macro call that should be transformed by DEFUN

(defun nil ())

[Assistant]
(defmacro DEFUN ...)

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


[User]
Define a macro that eliminates this repetitive pattern:
(destructuring-bind () (progn))

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

(destructuring-bind () (progn))

[Assistant]
(defmacro DESTRUCTURING-BIND ...)

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


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

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

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

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

;; macroexpand:
(let ((#:g169 generator)) (loop do (if-generator ((item) #:g169) (progn (push (funcall function item) result)) (return))))


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

Problem: Macro call that should be transformed by AND

(and nil (progn))

[Assistant]
(defmacro AND ...)

;; macroexpand:
(if nil
    (progn))


[User]
Generate a defmacro form that transforms code like this:
(->)

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

(->)

[Assistant]
(defmacro -> ...)

;; macroexpand:
nil


[User]
Define a macro that eliminates this repetitive pattern:
(letrec (x) x)

Issue: Macro call that should be transformed by letrec

(letrec (x) x)

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

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

;; macroexpand:
(letrec-with psetq (x) x)


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

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

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

[Assistant]
(defmacro with-table-name (table-name &body body)
  `(let ((*table-name-scope* ,table-name))
     ,@body))

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


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

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

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

[Assistant]
(defmacro with-package ((var &optional (package var)) &body body)
  `(let ((,var (ensure-package ,package)))
     ,@body))

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


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

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

(without-trailing-space (funcall body))

[Assistant]
(defmacro without-trailing-space (&body body)
  (with-thunk (body)
    `(call-without-trailing-space ,body)))

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


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

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

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

[Assistant]
(defun fformat (&rest all)
  (apply #'format all))

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

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


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

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

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

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

Conveniences:

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

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

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

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

Examples:

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

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

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

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

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

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

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

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

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


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

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

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

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

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

   SEQS:

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

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

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

   FORMS:

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

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

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

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

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

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

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

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

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

                  ,@body))

             ;; Tagbody

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

             ;; Bindings

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

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

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

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

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

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

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

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

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


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

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

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

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

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


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

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

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

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

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


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

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

(destructuring-bind* nil
    (progn))

[Assistant]
(defmacro DESTRUCTURING-BIND* ...)

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


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

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

(set-dynamic nil (progn))

[Assistant]
(defmacro SET-DYNAMIC ...)

;; macroexpand:
(setf (dynamic (progn)) nil)


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

Issue: Macro call that should be transformed by actypecase

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

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

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


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

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

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

[Assistant]
(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)))

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


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

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

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

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

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

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

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

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

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

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


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

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

(def-launched-iter nil
    nil)

[Assistant]
(defmacro DEF-LAUNCHED-ITER ...)

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-value-binding on (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var ,list) (setf ,list (funcall ,by ,list))) `(progn (update ,var ,list) (setf ,list (cdr ,list))))) (T (end-for))))

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

(define-value-binding on (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var ,list) (setf ,list (funcall ,by ,list))) `(progn (update ,var ,list) (setf ,list (cdr ,list))))) (T (end-for))))

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

;; macroexpand:
(define-direct-binding on (var list &key (by nil by-p)) (let ((#:list137 (gensym #A((4) base-char . "LIST"))) (#:by138 (gensym #A((2) base-char . "BY")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:list137 list) (list #:by138 by) (loop for #:var136 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var136 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:list137 :kind 0) #S(sb-impl::comma :expr #:by138 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote list) :kind 0) #S(sb-impl::comma :expr #:list137 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((list #:list137) (by #:by138)) (declare (ignorable list by)) (sb-int:quasiquote (cond (#S(sb-impl::comma :expr list :kind 0) #S(sb-impl::comma :expr (if by-p (sb-int:quasiquote (progn (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr list :kind 0)) (setf #S(sb-impl::comma :expr list :kind 0) (funcall #S(sb-impl::comma :expr by :kind 0) #S(sb-impl::comma :expr list :kind 0))))) (sb-int:quasiquote (progn (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr list :kind 0)) (setf #S(sb-impl::comma :expr list :kind 0) (cdr #S(sb-impl::comma :expr list :kind 0)))))) :kind 0)) (t (end-for))))))))


[User]
Generate a defmacro form that transforms code like this:
(mvlet* nil)

Pattern to recognize: Macro call that should be transformed by MVLET*

(mvlet* nil)

[Assistant]
(defmacro MVLET* ...)

;; macroexpand:
(progn)


[User]
Define a macro that eliminates this repetitive pattern:
(with-trace-sql (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))

Issue: Macro call that should be transformed by with-trace-sql

(with-trace-sql (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))

[Assistant]
(defmacro with-trace-sql (&body body)
  `(let ((dbi:*sql-execution-hooks* (cons #'trace-sql
                                          dbi:*sql-execution-hooks*)))
     ,@body))

;; macroexpand:
(let ((*sql-execution-hooks* (cons (function trace-sql) *sql-execution-hooks*))) (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall `#'(lambda (,c) (declare (magic)) ,(cps-convert-progn body c types value? environment)) '() continuation t)))

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

(defun-compile-time cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall `#'(lambda (,c) (declare (magic)) ,(cps-convert-progn body c types value? environment)) '() continuation t)))

[Assistant]
(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))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun cps-convert-block (name body continuation types value? environment) (let* ((c (gensym "CONTINUATION-")) (*block-tags* (cons (list name c types value?) *block-tags*))) (possibly-beta-reduce-funcall (sb-int:quasiquote (function (lambda (#S(sb-impl::comma :expr c :kind 0)) (declare (magic)) #S(sb-impl::comma :expr (cps-convert-progn body c types value? environment) :kind 0)))) (quote nil) continuation t))) (eval-when (:compile-toplevel) (compile (quote cps-convert-block))))


[User]
Define a macro that eliminates this repetitive pattern:
(dletf nil)

Issue: Macro call that should be transformed by DLETF

(dletf nil)

[Assistant]
(defmacro DLETF ...)

;; macroexpand:
(special-symbol-progv (with-symbol-access
                        (list))
    (list)
  (locally (declare (special))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-error invalid-symbol-macro-form () (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)

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

(define-error invalid-symbol-macro-form () (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)

[Assistant]
(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))

;; macroexpand:
(defcondition invalid-symbol-macro-form (:error-type varjo-error :prefix "Varjo") (name form) "Symbol macros must expand to a list or atom form : ~s -> ~s~%" name form)


[User]
Generate a defmacro form that transforms code like this:
(def-dynenv-fun nil
    :key
  nil)

Pattern to recognize: Macro call that should be transformed by DEF-DYNENV-FUN

(def-dynenv-fun nil
    :key
  nil)

[Assistant]
(defmacro DEF-DYNENV-FUN ...)

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun nil (&rest #:args) (apply (dynenv-function nil) #:args))
  (defvar #:nil145 (lambda :key nil))
  (setf (get 'nil 'dynenv-fun) '#:nil145))


[User]
Generate a defmacro form that transforms code like this:
(acond ((+ 2 2) (setf foo 38) (incf foo it) foo) (t nil))

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

(acond ((+ 2 2) (setf foo 38) (incf foo it) foo) (t nil))

[Assistant]
(defmacro acond (&body clauses)
  "Like COND, except result of each test-form is bound to IT (via LET) for the
scope of the corresponding clause."
  (labels ((rec (clauses)
	     (if clauses
		 (destructuring-bind ((test &body body) . rest)  clauses
		   (if body
		       `(anaphoric if ,test (progn ,@body) ,(rec rest))
		       `(anaphoric if ,test it ,(rec rest))))
		 nil)))
    (rec clauses)))

;; macroexpand:
(let ((#:it (+ 2 2))) (if #:it (let ((it #:it)) (declare (ignorable it)) (setf foo 38) (incf foo it) foo) (acond (t nil))))


[User]
Write a Common Lisp macro to handle this code pattern:
(is (= (* 2 a) (dummy-add a a)))

Problem: Macro call that should be transformed by is

(is (= (* 2 a) (dummy-add a a)))

[Assistant]
(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)))))))

;; macroexpand:
(let ((#:e164 (* 2 a)) (#:a165 (dummy-add a a))) (if (progn (= #:e164 #:a165)) (add-result (quote test-passed) :test-expr (quote (= (* 2 a) (dummy-add a a)))) (process-failure (quote (= (* 2 a) (dummy-add a a))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (dummy-add a a)) #:a165 (quote =) #:e164)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-error assigning-to-readonly () (var-name) "Assignment failed as ~a is readonly" var-name)

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

(define-error assigning-to-readonly () (var-name) "Assignment failed as ~a is readonly" var-name)

[Assistant]
(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))

;; macroexpand:
(defcondition assigning-to-readonly (:error-type varjo-error :prefix "Varjo") (var-name) "Assignment failed as ~a is readonly" var-name)


[User]
Write a Common Lisp macro to handle this code pattern:
(when (cdr head) (cons 'progn (cdr head)))

Problem: Macro call that should be transformed by when

(when (cdr head) (cons 'progn (cdr head)))

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

;; macroexpand:
(if (cdr head) (cons (quote progn) (cdr head)))


[User]
Define a macro that eliminates this repetitive pattern:
(when nil (progn))

Issue: Macro call that should be transformed by WHEN

(when nil (progn))

[Assistant]
(defmacro WHEN ...)

;; macroexpand:
(if nil
    (progn))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(rem-bops nil nil)

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

(rem-bops nil nil)

[Assistant]
(defmacro REM-BOPS ...)

;; macroexpand:
(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn (save-binfix) (mapc 'rmbop '(nil nil)) (assign-properties)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(%destructure-defhook-args args (with-effective-qualifier generic-function qualifier (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))))

Write a macro that addresses: Macro call that should be transformed by %destructure-defhook-args

(%destructure-defhook-args args (with-effective-qualifier generic-function qualifier (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))))

[Assistant]
(defmacro %destructure-defhook-args (args &body body)
  (let ((args-sym (gensym)))
    `(let* ((,args-sym ,args)
            (qualifier
            (cond ((and (symbolp (car ,args-sym)) (not (null (car ,args-sym))))
                   (prog1 (car ,args-sym) (setf ,args-sym (cdr ,args-sym))))
                  (t :use-default))))
       (destructuring-bind (specialized-lambda-list &body body) ,args-sym
         ,@body))))

;; macroexpand:
(let* ((#:g123 args) (qualifier (cond ((and (symbolp (car #:g123)) (not (null (car #:g123)))) (prog1 (car #:g123) (setf #:g123 (cdr #:g123)))) (t :use-default)))) (destructuring-bind (specialized-lambda-list &body body) #:g123 (with-effective-qualifier generic-function qualifier (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form 'go))

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

(defun-compile-time walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form 'go))

[Assistant]
(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))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun walk-go (map-function form) (unless (null (rest (last form))) (error "Improper GO: ~S" form)) (unless (= (length form) 2) (error "GO must have one argument: ~S" form)) (unless (or (symbolp (second form)) (integerp (second form))) (error "TAG of GO must be a symbol or integer: ~S" form)) (funcall map-function form (quote go))) (eval-when (:compile-toplevel) (compile (quote walk-go))))


[User]
Write a Common Lisp macro to handle this code pattern:
(draw scene (:image :x 10 :y 10 :height 600 :width 600 :xlink-href img-url))

Problem: Macro call that should be transformed by draw

(draw scene (:image :x 10 :y 10 :height 600 :width 600 :xlink-href img-url))

[Assistant]
(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)))

;; macroexpand:
(let ((#:g155 (funcall (function make-svg-element) :image (append (list :x 10 :y 10 :height 600 :width 600 :xlink-href img-url) (list))))) (add-element scene #:g155) #:g155)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(mvlet* ((low high (sort-values #'< start stop)) (in-order? (eql low start)) (element-type (if in-order? `(integer ,low (,high)) `(integer (,low) ,high))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type))

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

(mvlet* ((low high (sort-values #'< start stop)) (in-order? (eql low start)) (element-type (if in-order? `(integer ,low (,high)) `(integer (,low) ,high))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type))

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

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

    (var var*... expr)

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

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

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

;; macroexpand:
(multiple-value-bind (low high) (sort-values (function <) start stop) (mvlet* ((in-order? (eql low start)) (element-type (if in-order? (sb-int:quasiquote (integer #S(sb-impl::comma :expr low :kind 0) (#S(sb-impl::comma :expr high :kind 0)))) (sb-int:quasiquote (integer (#S(sb-impl::comma :expr low :kind 0)) #S(sb-impl::comma :expr high :kind 0))))) (len (ceiling (abs (- high low)) (abs step)))) (values len element-type)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(c? (if (value bypass-lookup?) 'no-lookup (bwhen-c-stored (v :bar store 'nothing) (value v))))

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

(c? (if (value bypass-lookup?) 'no-lookup (bwhen-c-stored (v :bar store 'nothing) (value v))))

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

;; macroexpand:
(make-c-dependent :code (quote ((if (value bypass-lookup?) (quote no-lookup) (bwhen-c-stored (v :bar store (quote nothing)) (value v))))) :value-state :unevaluated :rule (c-lambda (if (value bypass-lookup?) (quote no-lookup) (bwhen-c-stored (v :bar store (quote nothing)) (value v)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defgenerator repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (if n (dotimes (i n) (yield item)) (loop do (yield item))))

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

(defgenerator repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (if n (dotimes (i n) (yield item)) (loop do (yield item))))

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

;; macroexpand:
(defun repeat (item &optional n) "Returns a single item indefinitely, or up to n times." (with-yield (if n (dotimes (i n) (yield item)) (loop do (yield item)))))


[User]
Generate a defmacro form that transforms code like this:
;; Common pattern: test a value, use result in then-branch
(let ((result (compute-something)))
  (if result
      (format t "Got: ~a~%" result)
      :nothing))

;; Want: implicit 'it' bound to test result

Pattern to recognize: Repeated pattern of binding test result then branching on it — want implicit 'it' anaphor

;; Common pattern: test a value, use result in then-branch
(let ((result (compute-something)))
  (if result
      (format t "Got: ~a~%" result)
      :nothing))

;; Want: implicit 'it' bound to test result

[Assistant]
(defmacro aif (test then &optional else)
  `(let ((it ,test))
     (if it ,then ,else)))

;; macroexpand:
;; (aif (compute-something)
;;      (format t "Got: ~a~%" it)
;;      :nothing)
;; Expands to:
;; (LET ((IT (COMPUTE-SOMETHING)))
;;   (IF IT
;;       (FORMAT T "Got: ~a~%" IT)
;;       :NOTHING))


[User]
Generate a defmacro form that transforms code like this:
(dynamic-let nil
  (progn))

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

(dynamic-let nil
  (progn))

[Assistant]
(defmacro DYNAMIC-LET ...)

;; macroexpand:
(let ()
  (dynamic-wind
    :proceed
    #:g194
    (let ()
      (declare (special))
      (#:g194 (progn)))))


[User]
Define a macro that eliminates this repetitive pattern:
(def-easy-macro nil
    (progn))

Issue: Macro call that should be transformed by DEF-EASY-MACRO

(def-easy-macro nil
    (progn))

[Assistant]
(defmacro DEF-EASY-MACRO ...)

;; macroexpand:
(progn
 (defun call-nil (#:|fn127| progn)
   (flet ((#:|fn127| (&rest args) (declare (inline)) (apply #:|fn127| args)))))
 (defmacro nil ((&rest fn-arg-values) &body macro-body)
   nil
   (build-funcall 'call-nil '(progn) fn-arg-values macro-body)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-definition-resolver class designator-class-p)

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

(define-simple-definition-resolver class designator-class-p)

[Assistant]
(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))))))

;; macroexpand:
(define-definition-resolver class (class #:package137) (when (ignore-errors (designator-class-p class)) (list (make-instance (quote class) :designator class :package #:package137))))


[User]
Define a macro that eliminates this repetitive pattern:
(defpattern nil
    :key
  nil)

Issue: Macro call that should be transformed by DEFPATTERN

(defpattern nil
    :key
  nil)

[Assistant]
(defmacro DEFPATTERN ...)

;; macroexpand:
(eval-always
  (setf (get 'nil 'cl-match-pattern)
          (lambda (#:g133)
            (lett :key
                #:g133
              nil))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-ps-symbol-macro nil nil)

Write a macro that addresses: Macro call that should be transformed by DEFINE-PS-SYMBOL-MACRO

(define-ps-symbol-macro nil nil)

[Assistant]
(defmacro DEFINE-PS-SYMBOL-MACRO ...)

;; macroexpand:
(progn
 nil
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf (gethash 'nil *symbol-macro-toplevel*)
           (lambda (form) (declare (ignore form)) 'nil))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite cddaar (expr) `(cdr (cdaar ,(second expr))))

Issue: Macro call that should be transformed by define-modf-rewrite

(define-modf-rewrite cddaar (expr) `(cdr (cdaar ,(second expr))))

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(lambda+ nil)

Problem: Macro call that should be transformed by LAMBDA+

(lambda+ nil)

[Assistant]
(defmacro LAMBDA+ ...)

;; macroexpand:
(lambda () (let+ nil))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(reduced-typecase nil nil)

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

(reduced-typecase nil nil)

[Assistant]
(defmacro REDUCED-TYPECASE ...)

;; macroexpand:
(typecase nil (nil))


[User]
Generate a defmacro form that transforms code like this:
(with-special-initargs nil
  nil)

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

(with-special-initargs nil
  nil)

[Assistant]
(defmacro WITH-SPECIAL-INITARGS ...)

;; macroexpand:
(funcall-with-special-initargs (list) (lambda () nil))


[User]
Write a Common Lisp macro to handle this code pattern:
(list-of nil)

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

(list-of nil)

[Assistant]
(defmacro LIST-OF ...)

;; macroexpand:
(lc (nil) collect)


[User]
Generate a defmacro form that transforms code like this:
(with-yield-binds (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s))))

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

(with-yield-binds (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (with-output-to-string (s) (write-string (yield (column-definition-clause-column-name clause)) s) (when (column-definition-clause-type clause) (let ((*use-placeholder* nil)) (format s " ~A" (yield (column-definition-clause-type clause))))) (when (column-definition-clause-not-null clause) (write-string " NOT NULL" s)) (when (column-definition-clause-default clause) (format s " DEFAULT ~A" (yield (column-definition-clause-default clause)))) (when (column-definition-clause-auto-increment clause) (write-string " AUTO_INCREMENT" s)) (when (column-definition-clause-unique clause) (write-string " UNIQUE" s)) (when (column-definition-clause-primary-key clause) (write-string " PRIMARY KEY" s)) (when (and (column-definition-clause-autoincrement clause) (not (column-definition-clause-auto-increment clause))) (write-string " AUTOINCREMENT" s)))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Generate a defmacro form that transforms code like this:
(-<>> 'some-name)

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

(-<>> 'some-name)

[Assistant]
(defmacro -<>> ...)

;; macroexpand:
'some-name


[User]
Generate a defmacro form that transforms code like this:
(defmethod* nil nil)

Pattern to recognize: Macro call that should be transformed by DEFMETHOD*

(defmethod* nil nil)

[Assistant]
(defmacro DEFMETHOD* ...)

;; macroexpand:
(let* ((#:nil125 (ensure-generic*-function 'nil))
       (temp-method (defmethod #:nil124 nil))
       (actual-gf
        (ensure-generic*-function 'nil :lambda-list
                                  (sb-mop:generic-function-lambda-list
                                   (symbol-function '#:nil124))
                                  :special-variables 'nil))
       (actual-method
        (add-method* #:nil125
                     (make-instance 'method* :special-variables (list)
                                    :qualifiers 'nil :specializers
                                    (sb-mop:method-specializers temp-method)
                                    :lambda-list
                                    (sb-mop:method-lambda-list temp-method)
                                    :documentation
                                    (documentation temp-method t) :function
                                    (sb-mop:method-function temp-method)))))
  (declare (ignorable #:nil125)
           (ignore actual-gf))
  (setf (documentation actual-method t) (documentation temp-method t))
  actual-method)


[User]
Generate a defmacro form that transforms code like this:
(letrec nil
  :key
  nil)

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

(letrec nil
  :key
  nil)

[Assistant]
(defmacro LETREC ...)

;; macroexpand:
(let ()
  (flet ()
    nil
    (setf)
    :key
    nil))


[User]
Define a macro that eliminates this repetitive pattern:
(deferror "42P06" duplicate-schema syntax-error-or-access-violation)

Issue: Macro call that should be transformed by deferror

(deferror "42P06" duplicate-schema syntax-error-or-access-violation)

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

;; macroexpand:
(progn (define-condition duplicate-schema (syntax-error-or-access-violation) nil) (setf (gethash "42P06" *error-table*) (quote duplicate-schema)))


[User]
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name)) (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

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

(with-prepared-query query (conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name)) (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

[Assistant]
(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))

;; macroexpand:
(call-with-prepared-query conn (format nil "SELECT currval(pg_get_serial_sequence('~A', '~A')) AS last_insert_id" table-name serial-key-name) (lambda (query) (or (first (dbi.driver:fetch (dbi.driver:execute query) :format :values)) 0)) :use-prepare-cached nil)


[User]
Generate a defmacro form that transforms code like this:
(define-modf-function nth 2 (new-val nth obj) (replace-nth nth obj new-val))

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

(define-modf-function nth 2 (new-val nth obj) (replace-nth nth obj new-val))

[Assistant]
(defmacro define-modf-function (name nth-arg (new-val &rest args) &body body)
  "Define a new modf function.  It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro."
  ;; Side effect in a macro, I know.  How can you do this via EVAL-WHEN if I
  ;; want it to run even if not a toplevel macro?
  (setf (gethash name *modf-nth-arg*)
        nth-arg)
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (setf (gethash ',name *modf-nth-arg*)
             ,nth-arg))
     (defun ,(intern (modf-name name) :modf) (,new-val ,@args)
       ,@body)))

;; macroexpand:
(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote nth) *modf-nth-arg*) 2)) (defun |BUILDER:COMMON-LISP:NTH| (new-val nth obj) (replace-nth nth obj new-val)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (eql (top-info) 'aref) (format stream ")"))

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

(when (eql (top-info) 'aref) (format stream ")"))

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

;; macroexpand:
(if (eql (top-info) (quote aref)) (format stream ")"))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(some-<>>
  nil
  :key
  nil)

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

(some-<>>
  nil
  :key
  nil)

[Assistant]
(defmacro SOME-<>> ...)

;; macroexpand:
(let* ((#:var145 nil)
       (#:var146
        (if #:var145
            (:key #:var145)
            nil))
       (#:var147
        (if #:var146
            (nil #:var146)
            nil)))
  #:var147)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-declaration nil
    (progn))

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

(define-declaration nil
    (progn))

[Assistant]
(defmacro DEFINE-DECLARATION ...)

;; macroexpand:
(sb-cltl2:define-declaration nil
    (progn))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name))))

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

(defun-compile-time get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name))))

[Assistant]
(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))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun get-function-record (function-name) (or (gethash function-name *function-record-table*) (setf (gethash function-name *function-record-table*) (make-function-record :function-name function-name)))) (eval-when (:compile-toplevel) (compile (quote get-function-record))))


[User]
Write a Common Lisp macro to handle this code pattern:
;; Macro with double-evaluation bug
(defmacro square (x)
  `(* ,x ,x))
;; (square (incf y)) evaluates (incf y) TWICE

;; Manual fix requires gensym + let boilerplate every time
(defmacro square (x)
  (let ((g (gensym)))
    `(let ((,g ,x))
       (* ,g ,g))))

Problem: Macro arguments evaluated multiple times (double evaluation) — need automatic once-only that also provides both original form and evaluated value

;; Macro with double-evaluation bug
(defmacro square (x)
  `(* ,x ,x))
;; (square (incf y)) evaluates (incf y) TWICE

;; Manual fix requires gensym + let boilerplate every time
(defmacro square (x)
  (let ((g (gensym)))
    `(let ((,g ,x))
       (* ,g ,g))))

[Assistant]
(defun o!-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 2)
       (string= (symbol-name s)
                "O!"
                :start1 0
                :end1 2)))

(defun o!-symbol-to-g!-symbol (s)
  (symb "G!"
        (subseq (symbol-name s) 2)))

(defmacro defmacro! (name args &rest body)
  (let* ((os (remove-if-not #'o!-symbol-p (flatten args)))
         (gs (mapcar #'o!-symbol-to-g!-symbol os)))
    (multiple-value-bind (body declarations docstring)
        (parse-body body :documentation t)
      `(defmacro/g! ,name ,args
         ,@(when docstring
            (list docstring))
         ,@declarations
         `(let ,(mapcar #'list (list ,@gs) (list ,@os))
            ,(progn ,@body))))))

;; macroexpand:
;; (defmacro! square (o!x)
;;   `(* ,g!x ,g!x))
;;
;; (macroexpand '(square (incf y)))
;; => (LET ((#:X1633 (INCF Y)))
;;      (* #:X1633 #:X1633))
;;
;; o!x = original form (still accessible via ',o!x)
;; g!x = evaluated value, bound once


[User]
Define a macro that eliminates this repetitive pattern:
(defgeneric* nil (progn))

Issue: Macro call that should be transformed by DEFGENERIC*

(defgeneric* nil (progn))

[Assistant]
(defmacro DEFGENERIC* ...)

;; macroexpand:
(ensure-generic*-function 'nil :name 'nil :lambda-list '(progn))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(make-obsolete mustache-context make-context "0.10.0")

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

(make-obsolete mustache-context make-context "0.10.0")

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

;; macroexpand:
(defun mustache-context (&rest args) #A((40) base-char . "Create mustache context from alist DATA.") (warn (quote deprecation-warning) :name (quote mustache-context) :replacement (quote make-context) :since "0.10.0") (apply (quote make-context) args))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(do-generator (a b (with-yield (dolist (x data) (yield x (1+ x))))) a (return b))

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

(do-generator (a b (with-yield (dolist (x data) (yield x (1+ x))))) a (return b))

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

;; macroexpand:
(let ((#:g171 (with-yield (dolist (x data) (yield x (1+ x)))))) (loop do (if-generator ((a b) #:g171) (progn a (return b)) (return))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-c-syntax-reader-for-each-case-mode c-reader-level-0)

What needs to change: Macro call that should be transformed by define-c-syntax-reader-for-each-case-mode

(define-c-syntax-reader-for-each-case-mode c-reader-level-0)

[Assistant]
(defmacro define-c-syntax-reader-for-each-case-mode (base-readtable-name)
  (check-type base-readtable-name symbol)
  (loop with case-modes = '(:upcase :downcase :preserve :invert)
        for mode in case-modes
        as name = (format-symbol :with-c-syntax.core "~A-~A" base-readtable-name mode)
        collect `(defreadtable ,name
                   (:merge ,base-readtable-name)
                   (:case ,mode))
          into bodies
        finally
           (return `(progn ,@bodies))))

;; macroexpand:
(progn (defreadtable c-reader-level-0-upcase (:merge c-reader-level-0) (:case :upcase)) (defreadtable c-reader-level-0-downcase (:merge c-reader-level-0) (:case :downcase)) (defreadtable c-reader-level-0-preserve (:merge c-reader-level-0) (:case :preserve)) (defreadtable c-reader-level-0-invert (:merge c-reader-level-0) (:case :invert)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-html-string (:ul (:li (:a "hai"))))

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

(with-html-string (:ul (:li (:a "hai"))))

[Assistant]
(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)))))

;; macroexpand:
(with-output-to-string (*html*) (with-html (:ul (:li (:a "hai")))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(aand (values nil t) it)

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

(aand (values nil t) it)

[Assistant]
(defmacro aand (first &rest rest)
  "Like AND, except binds the first argument to IT (via LET) for the
scope of the rest of the arguments."
  `(anaphoric and ,first ,@rest))

;; macroexpand:
(anaphoric and (values nil t) it)


[User]
Write a Common Lisp macro to handle this code pattern:
(with-open-temporary-file (f :keep t) (pathname f))

Problem: Macro call that should be transformed by with-open-temporary-file

(with-open-temporary-file (f :keep t) (pathname f))

[Assistant]
(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body)
  "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
  with STREAM bound to the temporary file stream.  Returns the values
  returned by BODY.  By default, the file is deleted when BODY is
  exited. If a true value is passed in KEEP, the file is not deleted
  when the body is exited.  See OPEN-TEMPORARY for more permitted
  options."
  `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep)))
     #+sbcl
     (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
     ,(if (and (constantp keep)
               keep)
          `(progn ,@body)
          `(unwind-protect
                (progn ,@body)
             (unless ,keep
               (close ,stream)
               (delete-file (pathname ,stream)))))))

;; macroexpand:
(with-open-stream (f (open-temporary)) (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) (progn (pathname f)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(some->> nil :key nil)

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

(some->> nil :key nil)

[Assistant]
(defmacro SOME->> ...)

;; macroexpand:
(let* ((#:|some123| nil)
       (#:|some123| (when #:|some123| (:key #:|some123|)))
       (#:|some123| (when #:|some123| (#:|some123|))))
  #:|some123|)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defun-compile-time expand-local-setq (pairs environment) (if (null pairs) '(progn) (let ((d (gensym "DUMMY-"))) `(let ((,d ,(first pairs))) (trail #'(lambda () (setq ,(first pairs) ,d))) ,@(if (null (rest (rest pairs))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment)) (expand-local-setq (rest (rest pairs)) environment)))))))

Write a macro that addresses: Macro call that should be transformed by defun-compile-time

(defun-compile-time expand-local-setq (pairs environment) (if (null pairs) '(progn) (let ((d (gensym "DUMMY-"))) `(let ((,d ,(first pairs))) (trail #'(lambda () (setq ,(first pairs) ,d))) ,@(if (null (rest (rest pairs))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment))) (list `(setq ,(first pairs) ,(perform-substitutions (second pairs) environment)) (expand-local-setq (rest (rest pairs)) environment)))))))

[Assistant]
(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))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun expand-local-setq (pairs environment) (if (null pairs) (quote (progn)) (let ((d (gensym "DUMMY-"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr d :kind 0) #S(sb-impl::comma :expr (first pairs) :kind 0))) (trail (function (lambda nil (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr d :kind 0))))) #S(sb-impl::comma :expr (if (null (rest (rest pairs))) (list (sb-int:quasiquote (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr (perform-substitutions (second pairs) environment) :kind 0)))) (list (sb-int:quasiquote (setq #S(sb-impl::comma :expr (first pairs) :kind 0) #S(sb-impl::comma :expr (perform-substitutions (second pairs) environment) :kind 0))) (expand-local-setq (rest (rest pairs)) environment))) :kind 2)))))) (eval-when (:compile-toplevel) (compile (quote expand-local-setq))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(lambda () nil)

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

(lambda () nil)

[Assistant]
(defmacro LAMBDA ...)

;; macroexpand:
#'(lambda () nil)


[User]
Generate a defmacro form that transforms code like this:
(resolving
  nil
  (progn))

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

(resolving
  nil
  (progn))

[Assistant]
(defmacro RESOLVING ...)

;; macroexpand:
(resolve
  nil
  (progn))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-decoder-simple-clos-semantics (is (equal-objects-p (make-instance 'frob :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class 'foo)) (finalize-inheritance (find-class 'goo)) (is (equal-objects-p (json:make-object '((bar . 46) (xyzzy . t) (quux . 98)) nil '(foo goo)) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) 'prototype)) (is (equalp '((bar . 46) (xyzzy . t) (quux . 98)) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))

Problem: Macro call that should be transformed by with-decoder-simple-clos-semantics

(with-decoder-simple-clos-semantics (is (equal-objects-p (make-instance 'frob :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class 'foo)) (finalize-inheritance (find-class 'goo)) (is (equal-objects-p (json:make-object '((bar . 46) (xyzzy . t) (quux . 98)) nil '(foo goo)) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) 'prototype)) (is (equalp '((bar . 46) (xyzzy . t) (quux . 98)) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))

[Assistant]
(defmacro with-decoder-simple-clos-semantics (&body body)
  "Execute BODY in a dynamic environement where the decoder semantics
is such as set by SET-DECODER-SIMPLE-CLOS-SEMANTICS."
  `(with-shadowed-custom-vars
     (set-decoder-simple-clos-semantics)
     ,@body))

;; macroexpand:
(with-shadowed-custom-vars (set-decoder-simple-clos-semantics) (is (equal-objects-p (make-instance (quote frob) :bar 46 :quux 98) (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")))) (finalize-inheritance (find-class (quote foo))) (finalize-inheritance (find-class (quote goo))) (is (equal-objects-p (make-object (quote ((bar . 46) (xyzzy . t) (quux . 98))) nil (quote (foo goo))) (decode-json-from-string (format nil input "{\"lispSuperclasses\": [\"foo\", \"goo\"], \"lispPackage\":\"jsonTest\"}")))) (is (typep (prototype (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"pFrob\"}"))) (quote prototype))) (is (equalp (quote ((bar . 46) (xyzzy . t) (quux . 98))) (decode-json-from-string (format nil input "{\"lispClass\": \"cons\", \"lispPackage\":\"jsonTest\"}")))) (is (loop with ht = (decode-json-from-string (format nil input "{\"lispClass\": \"hashTable\", \"lispPackage\":\"jsonTest\"}")) initially (if (/= (hash-table-count ht) 3) (return nil)) for k being each hash-key of ht using (hash-value v) always (case k (bar (eql v 46)) (xyzzy (eql v t)) (quux (eql v 98)) (t nil)))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(action (:after node-lisp node bound-variables) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq)))) (setf unsafe? t)) (values))

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

(action (:after node-lisp node bound-variables) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq)))) (setf unsafe? t)) (values))

[Assistant]
(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))))

;; macroexpand:
(make-action (quote :after) (quote node-lisp) (lambda (node bound-variables) (declare (type node-lisp node)) (when (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test (function eq))))) (setf unsafe? t)) (values)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (find (first x) (list 'flag)) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))

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

(when (find (first x) (list 'flag)) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))

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

;; macroexpand:
(if (find (first x) (list (quote flag))) (let ((s (short x)) (l (long x))) (if s (push s flags-short)) (if l (push l flags-long))))


[User]
Write a Common Lisp macro to handle this code pattern:
(is (< less more))

Problem: Macro call that should be transformed by is

(is (< less more))

[Assistant]
(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)))))))

;; macroexpand:
(let ((#:e247 less) (#:a248 more)) (if (progn (< #:e247 #:a248)) (add-result (quote test-passed) :test-expr (quote (< less more))) (process-failure (quote (< less more)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote more) #:a248 (quote <) #:e247)))


[User]
Define a macro that eliminates this repetitive pattern:
(deferror "57014" query-canceled operator-intervention)

Issue: Macro call that should be transformed by deferror

(deferror "57014" query-canceled operator-intervention)

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

;; macroexpand:
(progn (define-condition query-canceled (operator-intervention) nil) (setf (gethash "57014" *error-table*) (quote query-canceled)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
;; Manual dispatch by keyword with multiple lambdas is repetitive
(let ((count 0))
  (setf (symbol-function 'counter)
        (lambda (&rest args)
          (case (car args)
            (:inc (apply (lambda (n) (incf count n)) (cdr args)))
            (:dec (apply (lambda (n) (decf count n)) (cdr args)))
            (:reset (progn (setf count 0) nil))
            (t (error "Unknown: ~a" (car args)))))))

;; Every method: keyword, lambda wrapper, arg destructuring - repetitive

Write a macro that addresses: Repeated keyword-dispatch with automatic argument destructuring — each keyword maps to a lambda with its own parameter list

;; Manual dispatch by keyword with multiple lambdas is repetitive
(let ((count 0))
  (setf (symbol-function 'counter)
        (lambda (&rest args)
          (case (car args)
            (:inc (apply (lambda (n) (incf count n)) (cdr args)))
            (:dec (apply (lambda (n) (decf count n)) (cdr args)))
            (:reset (progn (setf count 0) nil))
            (t (error "Unknown: ~a" (car args)))))))

;; Every method: keyword, lambda wrapper, arg destructuring - repetitive

[Assistant]
(defmacro! dlambda (&rest ds)
  `(lambda (&rest ,g!args)
     (case (car ,g!args)
       ,@(mapcar
           (lambda (d)
             `(,(if (eq t (car d))
                  t
                  (list (car d)))
               (apply (lambda ,@(cdr d))
                      ,(if (eq t (car d))
                         g!args
                         `(cdr ,g!args)))))
           ds))))

;; macroexpand:
;; (dlambda
;;   (:inc (n) (incf count n))
;;   (:dec (n) (decf count n))
;;   (:reset () (setf count 0))
;;   (t (&rest args) (format t "Unknown: ~a~%" args)))
;;
;; Expands to a single lambda with case dispatch.
;; Each method has its own destructured argument list.
;; t as the key provides a default/catch-all.


[User]
Write a Common Lisp macro to handle this code pattern:
(def-dynenv-var nil (progn))

Problem: Macro call that should be transformed by DEF-DYNENV-VAR

(def-dynenv-var nil (progn))

[Assistant]
(defmacro DEF-DYNENV-VAR ...)

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar #:nil173 (load-time-value (progn)))
  (setf (get 'nil 'dynenv-var) '#:nil173)
  (define-symbol-macro nil (get-dynenv-var 'nil)))


[User]
Define a macro that eliminates this repetitive pattern:
(-> :g ((a (n) b c (d e f))) (put (list a n b c d e f)))

Issue: Macro call that should be transformed by ->

(-> :g ((a (n) b c (d e f))) (put (list a n b c d e f)))

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

;; macroexpand:
(atomically :g ((a (n) b c (d e f))) (put (list a n b c d e f)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(deftag dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string 'dynamic-tag-thunk))) (attrs (escape-attrs nil attrs))) `(prog1 nil (flet ((,thunk () ,@(loop for expr in body collect `(catch-output ,expr)))) (declare (dynamic-extent #',thunk)) (dynamic-tag* ,name (list ,@attrs) #',thunk ,empty?)))))

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

(deftag dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string 'dynamic-tag-thunk))) (attrs (escape-attrs nil attrs))) `(prog1 nil (flet ((,thunk () ,@(loop for expr in body collect `(catch-output ,expr)))) (declare (dynamic-extent #',thunk)) (dynamic-tag* ,name (list ,@attrs) #',thunk ,empty?)))))

[Assistant]
(defmacro deftag (name (body attrs-var &rest ll) &body tag)
  "Define NAME as a tag.
If NAME is not a keyword, it will also be defined as a macro with an
implicit `with-html'."
  (let ((definer
          (if (keywordp name)
              'deftag/keyword
              'deftag/macro)))
    `(,definer ,name (,body ,attrs-var ,@ll) ,@tag)))

;; macroexpand:
(deftag/macro dynamic-tag (body attrs &key name) (unless name (error "No tag name")) (let ((empty? (null body)) (thunk (gensym (string (quote dynamic-tag-thunk)))) (attrs (escape-attrs nil attrs))) (sb-int:quasiquote (prog1 nil (flet ((#S(sb-impl::comma :expr thunk :kind 0) nil #S(sb-impl::comma :expr (loop for expr in body collect (sb-int:quasiquote (catch-output #S(sb-impl::comma :expr expr :kind 0)))) :kind 2))) (declare (dynamic-extent (function #S(sb-impl::comma :expr thunk :kind 0)))) (dynamic-tag* #S(sb-impl::comma :expr name :kind 0) (list #S(sb-impl::comma :expr attrs :kind 2)) (function #S(sb-impl::comma :expr thunk :kind 0)) #S(sb-impl::comma :expr empty? :kind 0)))))))


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

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

(some->
  nil
  (progn))

[Assistant]
(defmacro SOME-> ...)

;; macroexpand:
(let* ((#:var171 nil)
       (#:var172
        (if #:var171
            (progn #:var171)
            nil)))
  #:var172)


[User]
Define a macro that eliminates this repetitive pattern:
(c-assert (listp old-kids))

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

(c-assert (listp old-kids))

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

;; macroexpand:
(unless *stop* (unless (listp old-kids) (c-break "failed assertion: ~a" (quote (listp old-kids)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(continue-whopper)

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

(continue-whopper)

[Assistant]
(defmacro CONTINUE-WHOPPER ...)

;; macroexpand:
(call-next-method-fn self class-env inst-env mcs%caller mcs%next-methods
                     mcs%args)


[User]
Write a Common Lisp macro to handle this code pattern:
(reduced-typecase nil)

Problem: Macro call that should be transformed by REDUCED-TYPECASE

(reduced-typecase nil)

[Assistant]
(defmacro REDUCED-TYPECASE ...)

;; macroexpand:
(typecase nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defsynonym there-is :there-is)

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

(defsynonym there-is :there-is)

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

;; macroexpand:
(eval-always (setf (get (quote there-is) (quote synonym)) (quote :there-is)))


[User]
Generate a defmacro form that transforms code like this:
(do+ inner-loop (do+ (terminate outer-loop 3)))

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

(do+ inner-loop (do+ (terminate outer-loop 3)))

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

;; macroexpand:
(do+/internal nil inner-loop (do+ (terminate outer-loop 3)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(iterate:declare-variables)

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

(iterate:declare-variables)

[Assistant]
(defmacro iter (&body body &environment env)
  "Jonathan Amsterdam's powerful and extensible iteration facility,
providing multiple accumulation, generators, memory of previous
iterations, over 50 clauses to start with and a Lisp-like syntax.
Evaluate (iterate:display-iterate-clauses) for an overview of clauses"
  (let* ((*env* env)
	 (*result-var* (genvar 'result))
	 (*type-alist* nil)
	 (*declare-variables* *always-declare-variables*)
	 (*bindings* nil)
	 (*internal-variables* nil)
	 (*previous-vars-alist* nil)
	 (*declarations* nil)
	 (*loop-body-wrappers* nil)
	 (*accum-var-alist* nil)
	 (*shared-bindings-alist* nil)
	 (*top-level?* t)
	 (*binding-context?* nil)
	 (*temps* nil)
	 (*temps-in-use* nil)
	 (*driver-info-alist* nil)
	 (*loop-name* (if (symbolp (car body))
			  (car body)
			  (gensym "ITERATE")))
	 (*block-name* (if (symbolp (car body))
			   (pop body)
			   nil))
	 (*loop-top* (symbol-append 'loop-top- *block-name*))
	 (*loop-step* (symbol-append 'loop-step- *block-name*))
	 (*loop-end* (symbol-append 'loop-end- *block-name*))
	 (*loop-step-used?* nil)
	 (*loop-end-used?* nil))
    (process-top-level-decls body)
    (multiple-value-bind (body decls init-code steppers final-code final-prot)
	(walk-list body)
      (multiple-value-bind (init step)
	  (insert-previous-code)
	(augment init-code init)
	(augment steppers step))
      (prepend (default-driver-code) body)
      (let* ((it-bod `(block ,*loop-name*
			(tagbody
			  (progn ,.init-code)
			  ,*loop-top*
			  (progn ,.body)
			  ,.(if *loop-step-used?* (list *loop-step*))
			  (progn ,.steppers)
			  (go ,*loop-top*)
			  ,.(if *loop-end-used?* (list *loop-end*))
			  (progn ,.final-code))
			,(if (member *result-var* *bindings* :key #'car)
			   *result-var*
			   nil)))
	     (it-bod (if (eql *block-name* nil)
			 `(block nil ,it-bod)
			 it-bod)))
	(wrap-form *loop-body-wrappers*
		   `(let* ,(nreverse *bindings*)
		     ,.(if *declarations*
			   `((declare .,*declarations*)))
		     ,.decls
		     ,(if final-prot
			  `(unwind-protect ,it-bod .,final-prot)
			  it-bod)))))))

;; macroexpand:
(declare-variables)