[User]
Generate a defmacro form that transforms code like this:
(with-color (:yellow :stream stream) (format/indent reporter stream "△ Looks like you planned ~D test~:*~P but ran ~A.~%" plan count))

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

(with-color (:yellow :stream stream) (format/indent reporter stream "△ Looks like you planned ~D test~:*~P but ran ~A.~%" plan count))

[Assistant]
(defmacro with-color ((color &rest args) &body body)
  (cond
    ((or (eq color :gray)
         (eq color :grey))
     `(if *enable-colors*
          (with-gray ,(or (getf args :stream) t) ,@body)
          (progn ,@body)))
    (T `(if *enable-colors*
            (if (or (eq ,color :gray)
                    (eq ,color :grey)
                    (eq ,color cl-colors:+gray+)
                    (eq ,color cl-colors:+grey+))
                (with-gray ,(or (getf args :stream) t) ,@body)
                (cl-ansi-text:with-color (,color ,@args) ,@body))
            (progn ,@body)))))

;; macroexpand:
(if *enable-colors* (if (or (eq :yellow :gray) (eq :yellow :grey) (eq :yellow +gray+) (eq :yellow +grey+)) (with-gray stream (format/indent reporter stream "△ Looks like you planned ~D test~:*~P but ran ~A.~%" plan count)) (cl-ansi-text:with-color (:yellow :stream stream) (format/indent reporter stream "△ Looks like you planned ~D test~:*~P but ran ~A.~%" plan count))) (progn (format/indent reporter stream "△ Looks like you planned ~D test~:*~P but ran ~A.~%" plan count)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(enable-quasi-quoted-binary-syntax)

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

(enable-quasi-quoted-binary-syntax)

[Assistant]
(defmacro ENABLE-QUASI-QUOTED-BINARY-SYNTAX ...)

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defsynonym :minimizing :min)

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

(defsynonym :minimizing :min)

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

;; macroexpand:
(eval-always (setf (get (quote :minimizing) (quote synonym)) (quote :min)))


[User]
Define a macro that eliminates this repetitive pattern:
(with-html-string (:a :href "#" :data-instant nil))

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

(with-html-string (:a :href "#" :data-instant nil))

[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 (:a :href "#" :data-instant nil)))


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

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

(let-syntax 'some-name)

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

;; macroexpand:
(letrec-syntax (common-lisp:quote) (let-syntax (some-name)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
($op* op l)

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

($op* op l)

[Assistant]
(defmacro $op (op &rest args)
  (cond ((consp (car args)) `(map-reduce-op ,op ($exp+ ,@args)))
	(t                   `($op* ,op ,@args))))

;; macroexpand:
(multiple-value-bind (#:g325 #:g328) (op-split (unwrap (list ($exp+ l)))) (let ((#:g327 (kv (car #:g325) (kv op #:g328)))) (dolist (#:g326 (cdr #:g325)) (setf #:g327 (kv #:g327 (kv #:g326 (kv op #:g328))))) #:g327))


[User]
Generate a defmacro form that transforms code like this:
(define-global-parameter nil nil)

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

(define-global-parameter nil nil)

[Assistant]
(defmacro DEFINE-GLOBAL-PARAMETER ...)

;; macroexpand:
(progn
 (store-in-symbol-plist nil nil .value-key.)
 (sb-ext:defglobal nil (get 'nil +value-key+))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf nil (get 'nil +value-key+)))
 (remprop 'nil +value-key+)
 'nil)


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

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

(with-access nil
    nil)

[Assistant]
(defmacro with-access ((&rest keys) val-form &body body)
  "Similar to with-accessors except using the access functions"
  (let* ((gval (gensym "val"))
     (forms
      (iter (for k in keys)
        (for (k-to k-from) = (if (listp k) k (list k k)))
        (collect `(,k-to (access ,gval ',k-from))))))
    `(let ((,gval ,val-form))
       (declare (ignorable ,gval))
       (symbol-macrolet (,@forms)
     ,@body
     ))))

;; macroexpand:
(let ((#:|val241| nil))
  (declare (ignorable #:|val241|))
  (symbol-macrolet ()))


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

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

($> "l" -9)

[Assistant]
(defmacro $ (&rest args)
  `(kv ,@args))

;; macroexpand:
($op "$gt" "l" -9)


[User]
Define a macro that eliminates this repetitive pattern:
(define-value-binding in (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var (car ,list)) (setf ,list (funcall ,by ,list))) `(update ,var (pop ,list)))) (T (end-for))))

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

(define-value-binding in (var list &key (by NIL by-p)) (declare (type list list)) `(cond (,list ,(if by-p `(progn (update ,var (car ,list)) (setf ,list (funcall ,by ,list))) `(update ,var (pop ,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 in (var list &key (by nil by-p)) (let ((#:list134 (gensym #A((4) base-char . "LIST"))) (#:by135 (gensym #A((2) base-char . "BY")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:list134 list) (list #:by135 by) (loop for #:var133 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var133 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:list134 :kind 0) #S(sb-impl::comma :expr #:by135 :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 #:list134 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((list #:list134) (by #:by135)) (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) (car #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 (update #S(sb-impl::comma :expr var :kind 0) (pop #S(sb-impl::comma :expr list :kind 0))))) :kind 0)) (t (end-for))))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(collect-nth nil :key nil)

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

(collect-nth nil :key nil)

[Assistant]
(defmacro COLLECT-NTH ...)

;; macroexpand:
(common-lisp:let* ((#:generator-420 (generator :key))
                   #:items-412
                   (#:counter-414 nil)
                   (#:item-415 nil))
  (declare (type generator #:generator-420)
           (type (null-or fixnum) #:counter-414)
           (type (null-or t) #:item-415))
  (tagbody
   #:ll-421
    (setq #:items-412 (next-in #:generator-420 (go end)))
    (when (zerop #:counter-414) (setq #:item-415 #:items-412) (go end))
    (decf #:counter-414)
    (go #:ll-421)
   end)
  #:item-415)


[User]
Define a macro that eliminates this repetitive pattern:
(pop-preprocessor-directive-token token-list :|_Pragma|)

Issue: Macro call that should be transformed by pop-preprocessor-directive-token

(pop-preprocessor-directive-token token-list :|_Pragma|)

[Assistant]
(defmacro pop-preprocessor-directive-token (token-list directive-name &key (errorp t))
  "Pops the next token in TOKEN-LIST ignoring `+whitespace-marker+'"
  (with-gensyms (head_)
    `(let ((,head_
             (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)))
       (if (eq +whitespace-marker+ ,head_)
           (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)
           ,head_))))

;; macroexpand:
(let ((#:head_268 (check-and-pop-pp-directive-token-1 token-list :|_Pragma| t))) (if (eq +whitespace-marker+ #:head_268) (check-and-pop-pp-directive-token-1 token-list :|_Pragma| t) #:head_268))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(loop 'some-name)

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

(loop 'some-name)

[Assistant]
(defmacro LOOP ...)

;; macroexpand:
(block nil (tagbody #:g191 (progn 'some-name) (go #:g191)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-errno-symbol EILSEQ)

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

(define-errno-symbol EILSEQ)

[Assistant]
(defmacro define-errno-symbol (name)
  `(defparameter ,name
     (find-errno-symbol (string ',name))))

;; macroexpand:
(defparameter eilseq (find-errno-symbol (string (quote eilseq))))


[User]
Define a macro that eliminates this repetitive pattern:
(destructuring-case 'some-name)

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

(destructuring-case 'some-name)

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

;; macroexpand:
(destructuring-case-alt 'some-name)


[User]
Generate a defmacro form that transforms code like this:
(define-test bad-dependency :depends-on (failing) (is = 5 5))

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

(define-test bad-dependency :depends-on (failing) (is = 5 5))

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

;; macroexpand:
(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote bad-dependency) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote bad-dependency) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (is = 5 5))) :parent (quote nil) (quote :depends-on) (quote (failing)))) (quote bad-dependency))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(signal-syntax-error* open-paren-pos "Opening paren has no matching closing paren.")

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

(signal-syntax-error* open-paren-pos "Opening paren has no matching closing paren.")

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

;; macroexpand:
(error (quote ppcre-syntax-error) :pos open-paren-pos :format-control "Opening paren has no matching closing paren." :format-arguments (list))


[User]
Generate a defmacro form that transforms code like this:
(dflet ((list ())) (is (eql 42 (list))))

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

(dflet ((list ())) (is (eql 42 (list))))

[Assistant]
(defmacro dflet ((&rest definitions) &body body)
  "Like FLET, but dynamically sets the FDEFINITIONS during the duration of
the BODY."
  `(progf
       ',(mapcar #'car definitions)
       (list
        ,.(mapcar (lambda (definition)
                    `(lambda ,(cadr definition)
                       ,@(cddr definition)))
                  definitions))
     ,@body))

;; macroexpand:
(progf (quote (list)) (list (lambda nil)) (is (eql 42 (list))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-option-expander nicknames (package &rest nicknames) (loop for nick in nicknames do (add-package-nickname package nick)))

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

(define-option-expander nicknames (package &rest nicknames) (loop for nick in nicknames do (add-package-nickname package nick)))

[Assistant]
(defmacro define-option-expander (name (package &rest arguments) &body body)
  (let ((args (gensym "ARGS")))
    `(defmethod expand-option ((,(gensym "TYPE") (eql ,(intern (string name) "KEYWORD"))) ,package ,args)
       (destructuring-bind ,arguments ,args
         ,@body))))

;; macroexpand:
(defmethod expand-option ((#:type122 (eql :nicknames)) package #:args121) (destructuring-bind (&rest nicknames) #:args121 (loop for nick in nicknames do (add-package-nickname package nick))))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-connection (let ((user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user 'trivial-types:property-list)) (let ((user (retrieve-one :user :by :name := "nitro_idiot" :as 'hash-table))) (is-type user 'hash-table)) (let* ((*default-row-type* 'hash-table) (user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user 'hash-table)) (let* ((*default-row-type* 'hash-table) (user (retrieve-one :user :by :name := "nitro_idiot" :as 'trivial-types:association-list))) (is-type user 'trivial-types:association-list)))

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

(with-connection (let ((user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user 'trivial-types:property-list)) (let ((user (retrieve-one :user :by :name := "nitro_idiot" :as 'hash-table))) (is-type user 'hash-table)) (let* ((*default-row-type* 'hash-table) (user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user 'hash-table)) (let* ((*default-row-type* 'hash-table) (user (retrieve-one :user :by :name := "nitro_idiot" :as 'trivial-types:association-list))) (is-type user 'trivial-types:association-list)))

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

;; macroexpand:
(let ((let (connect ((user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user (quote trivial-types:property-list))))) (unwind-protect (progn (let ((user (retrieve-one :user :by :name := "nitro_idiot" :as (quote hash-table)))) (is-type user (quote hash-table))) (let* ((*default-row-type* (quote hash-table)) (user (retrieve-one :user :by :name := "nitro_idiot"))) (is-type user (quote hash-table))) (let* ((*default-row-type* (quote hash-table)) (user (retrieve-one :user :by :name := "nitro_idiot" :as (quote trivial-types:association-list)))) (is-type user (quote trivial-types:association-list)))) (disconnect let)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-unique-names (s-indicator current-s-indicator) (defmacro symbolic (operation test &rest other-args) (with-unique-names (this-s) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) `(symbol-macrolet ((,this-s (internal-symbol-macrolet ((it ,current-s)) ,test)) (it ,this-s)) (,operation it ,@other-args))))) (defmacro anaphoric (op test &body body) (with-unique-names (this-s) (setf (get s-indicator current-s-indicator) this-s) `(let* ((it ,test) (,this-s it)) (declare (ignorable ,this-s)) (,op it ,@body)))))

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

(with-unique-names (s-indicator current-s-indicator) (defmacro symbolic (operation test &rest other-args) (with-unique-names (this-s) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) `(symbol-macrolet ((,this-s (internal-symbol-macrolet ((it ,current-s)) ,test)) (it ,this-s)) (,operation it ,@other-args))))) (defmacro anaphoric (op test &body body) (with-unique-names (this-s) (setf (get s-indicator current-s-indicator) this-s) `(let* ((it ,test) (,this-s it)) (declare (ignorable ,this-s)) (,op it ,@body)))))

[Assistant]
(defmacro with-unique-names ((&rest bindings) &body body)
  `(let ,(mapcar #'(lambda (binding)
		     (destructuring-bind (var prefix)
			 (if (consp binding) binding (list binding binding))
		       `(,var (gensym ,(string prefix)))))
		 bindings)
     ,@body))

;; macroexpand:
(let ((s-indicator (gensym #A((12) base-char . "S-INDICATOR-"))) (current-s-indicator (gensym #A((20) base-char . "CURRENT-S-INDICATOR-")))) (defmacro symbolic (operation test &rest other-args) (with-unique-names (this-s) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) (quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr this-s :kind 0) (internal-symbol-macrolet ((it #S(sb-impl::comma :expr current-s :kind 0))) #S(sb-impl::comma :expr test :kind 0))) (it #S(sb-impl::comma :expr this-s :kind 0))) (#S(sb-impl::comma :expr operation :kind 0) it #S(sb-impl::comma :expr other-args :kind 2))))))) (defmacro anaphoric (op test &body body) (with-unique-names (this-s) (setf (get s-indicator current-s-indicator) this-s) (quasiquote (let* ((it #S(sb-impl::comma :expr test :kind 0)) (#S(sb-impl::comma :expr this-s :kind 0) it)) (declare (ignorable #S(sb-impl::comma :expr this-s :kind 0))) (#S(sb-impl::comma :expr op :kind 0) it #S(sb-impl::comma :expr body :kind 2)))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-simple-type-map setf-expander cl:setf)

Write a macro that addresses: Macro call that should be transformed by define-simple-type-map

(define-simple-type-map setf-expander cl:setf)

[Assistant]
(defmacro define-simple-type-map (class type)
  `(defmethod type ((,class ,class))
     ',type))

;; macroexpand:
(defmethod type ((setf-expander setf-expander)) (quote setf))


[User]
Write a Common Lisp macro to handle this code pattern:
(ematch0 list ((cons it nil) (cons (funcall fn it nil) nil)) ((cons it rest) (cons (funcall fn it t) (mapcar1-with-next fn rest))))

Problem: Macro call that should be transformed by ematch0

(ematch0 list ((cons it nil) (cons (funcall fn it nil) nil)) ((cons it rest) (cons (funcall fn it t) (mapcar1-with-next fn rest))))

[Assistant]
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

;; macroexpand:
(match0 list ((cons it nil) (cons (funcall fn it nil) nil)) ((cons it rest) (cons (funcall fn it t) (mapcar1-with-next fn rest))) (_ (error "level0 match error!")))


[User]
Define a macro that eliminates this repetitive pattern:
(*> +table-open+ +skip-space+)

Issue: Macro call that should be transformed by *>

(*> +table-open+ +skip-space+)

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

;; macroexpand:
(lambda (#:*>-offset230) (multiple-value-bind (#:*>-res231 #:*>-next232) (funcall +table-open+ #:*>-offset230) (if (ok? #:*>-res231) (funcall +skip-space+ #:*>-next232) (fail #:*>-next232))))


[User]
Generate a defmacro form that transforms code like this:
(lambda-cmatch (PATTERN BODY...))

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

(lambda-cmatch (PATTERN BODY...))

[Assistant]
(defmacro lambda-cmatch (&body clauses)
  "Equivalent to (lambda (arg) (cmatch arg CLAUSES...))."
  (with-unique-names (arg)
    `(lambda (,arg) (cmatch ,arg ,@clauses))))

;; macroexpand:
(lambda (#:arg124) (cmatch #:arg124 (pattern body...)))


[User]
Write a Common Lisp macro to handle this code pattern:
(rte-ecase 'some-name)

Problem: Macro call that should be transformed by RTE-ECASE

(rte-ecase 'some-name)

[Assistant]
(defmacro RTE-ECASE ...)

;; macroexpand:
(let ((#:rte172 'some-name))
  (rte-ecase #:rte172
    ((:* t) (error "The sequence ~A fell through the RTE-ECASE" #:rte172))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-api register-readtable (name readtable) (symbol readtable => readtable) "Associate READTABLE with NAME. Returns the readtable." (assert (typep name '(not (satisfies reserved-readtable-name-p)))) (%associate-readtable-with-name name readtable) (%associate-name-with-readtable name readtable) readtable)

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

(define-api register-readtable (name readtable) (symbol readtable => readtable) "Associate READTABLE with NAME. Returns the readtable." (assert (typep name '(not (satisfies reserved-readtable-name-p)))) (%associate-readtable-with-name name readtable) (%associate-name-with-readtable name readtable) readtable)

[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 (symbol readtable) (values readtable &optional)) register-readtable)) (locally (declare (sb-ext:muffle-conditions style-warning)) (defun register-readtable (name readtable) "Associate READTABLE with NAME. Returns the readtable." (locally (declare (sb-ext:unmuffle-conditions style-warning)) (assert (typep name (quote (not (satisfies reserved-readtable-name-p))))) (%associate-readtable-with-name name readtable) (%associate-name-with-readtable name readtable) readtable))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-modf-function last 1 (new-val obj) (let ((len (length obj))) (replace-nthcdr (- len 1) obj new-val)))

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

(define-modf-function last 1 (new-val obj) (let ((len (length obj))) (replace-nthcdr (- len 1) 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 last) *modf-nth-arg*) 1)) (defun |BUILDER:COMMON-LISP:LAST| (new-val obj) (let ((len (length obj))) (replace-nthcdr (- len 1) obj new-val))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time callees (function-name) (function-record-callees (get-function-record function-name)))

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

(defun-compile-time callees (function-name) (function-record-callees (get-function-record 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 callees (function-name) (function-record-callees (get-function-record function-name))) (eval-when (:compile-toplevel) (compile (quote callees))))


[User]
Define a macro that eliminates this repetitive pattern:
(action (:after node-application) #'apply-candidate)

Issue: Macro call that should be transformed by action

(action (:after node-application) #'apply-candidate)

[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-application) (function apply-candidate))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defannotation metaclass (metaclass class-definition-form) (:arity 2) (progn-form-replace-last (lambda (class-definition-form) (if (get-class-option :metaclass class-definition-form) (error ":metaclass is not empty") (append class-definition-form `((:metaclass ,metaclass))))) class-definition-form))

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

(defannotation metaclass (metaclass class-definition-form) (:arity 2) (progn-form-replace-last (lambda (class-definition-form) (if (get-class-option :metaclass class-definition-form) (error ":metaclass is not empty") (append class-definition-form `((:metaclass ,metaclass))))) class-definition-form))

[Assistant]
(defmacro defannotation (name lambda-list options &body body)
  `(progn
     (set-annotation-options ',name ',options)
     (defmacro ,name ,lambda-list ,@body)))

;; macroexpand:
(progn (set-annotation-options (quote metaclass) (quote (:arity 2))) (defmacro metaclass (metaclass class-definition-form) (progn-form-replace-last (lambda (class-definition-form) (if (get-class-option :metaclass class-definition-form) (error ":metaclass is not empty") (append class-definition-form (sb-int:quasiquote ((:metaclass #S(sb-impl::comma :expr metaclass :kind 0))))))) class-definition-form)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(dispatch-serially ,flow-context ,flow-list)))

Problem: Macro call that should be transformed by with-flow-let-macro

(with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(dispatch-serially ,flow-context ,flow-list)))

[Assistant]
(defmacro with-flow-let-macro ((var flow) &body body)
  `(with-gensyms (,var)
     `(let ((,,var (list ,@,flow)))
        ,,@body)))

;; macroexpand:
(with-gensyms (flow-list) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr flow-list :kind 0) (list #S(sb-impl::comma :expr flow :kind 2)))) #S(sb-impl::comma :expr (flow-lambda-macro (flow-context) (sb-int:quasiquote (dispatch-serially #S(sb-impl::comma :expr flow-context :kind 0) #S(sb-impl::comma :expr flow-list :kind 0)))) :kind 0))))


[User]
Generate a defmacro form that transforms code like this:
(with-input-from-file (file-stream pathname :external-format external-format) (read-stream-content-into-string file-stream :buffer-size buffer-size))

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

(with-input-from-file (file-stream pathname :external-format external-format) (read-stream-content-into-string file-stream :buffer-size buffer-size))

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

;; macroexpand:
(with-open-file* (file-stream pathname :direction :input :external-format external-format) (read-stream-content-into-string file-stream :buffer-size buffer-size))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-ps-gensyms 'some-name)

Write a macro that addresses: Macro call that should be transformed by WITH-PS-GENSYMS

(with-ps-gensyms 'some-name)

[Assistant]
(defmacro WITH-PS-GENSYMS ...)

;; macroexpand:
(let* ((quote (ps-gensym #A((5) base-char . "QUOTE")))
       (some-name (ps-gensym "SOME-NAME"))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(dynamic-reprogv nil
    :key
  nil)

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

(dynamic-reprogv nil
    :key
  nil)

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

;; macroexpand:
(dynamic-wind
  :proceed
  #:proceed204
  (let* ((#:computed-symbols202 nil)
         (#:computed-bindings203 (compute-bindings #:computed-symbols202 :key)))
    (progv #:computed-symbols202 #:computed-bindings203 (#:proceed204 nil))))


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

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

(f_
  nil
  nil)

[Assistant]
(defmacro F_ ...)

;; macroexpand:
(lambda (_) nil nil)


[User]
Generate a defmacro form that transforms code like this:
(with-html-string (:tag :name "xy" "Hello"))

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

(with-html-string (:tag :name "xy" "Hello"))

[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 (:tag :name "xy" "Hello")))


[User]
Generate a defmacro form that transforms code like this:
(bind ((#(a b c) #(1 2 3))) (list a b c))

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

(bind ((#(a b c) #(1 2 3))) (list a b c))

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

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

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

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

;; macroexpand:
(let* ((#:|values-166| #(1 2 3)) (a (aref #:|values-166| 0)) (b (aref #:|values-166| 1)) (c (aref #:|values-166| 2))) (declare (ignorable #:|values-166|)) (progn (list a b c)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(the nil :key nil)

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

(the nil :key nil)

[Assistant]
(defmacro THE ...)

;; macroexpand:
(send self nil :key nil)


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

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

(m 'some-name)

[Assistant]
(defmacro M ...)

;; macroexpand:
(lambda (&rest #:|macro-lambda-list124|)
  (destructuring-bind (quote some-name) #:|macro-lambda-list124|))


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

Issue: Macro call that should be transformed by MATCH

(match nil
  (progn))

[Assistant]
(defmacro MATCH ...)

;; macroexpand:
(match* (nil)
  ((progn)))


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

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

(c-assert entry)

[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 entry (c-break "failed assertion: ~a" (quote entry))))


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

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

(producing nil nil)

[Assistant]
(defmacro PRODUCING ...)

;; macroexpand:
(non-opt-producing nil
    nil)


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

What needs to change: Macro call that should be transformed by CARDINALITY-CASE

(cardinality-case nil)

[Assistant]
(defmacro CARDINALITY-CASE ...)

;; macroexpand:
(let ((#:cardinality127 nil))
  (typecase #:cardinality127))


[User]
Write a Common Lisp macro to handle this code pattern:
(maybe-do-not-silence-errors (handler-case (call-next-method) (error (err) (setf (value result) (if (typep result 'multiple-value-result) (list err) err)) (setf (status result) :failed))))

Problem: Macro call that should be transformed by maybe-do-not-silence-errors

(maybe-do-not-silence-errors (handler-case (call-next-method) (error (err) (setf (value result) (if (typep result 'multiple-value-result) (list err) err)) (setf (status result) :failed))))

[Assistant]
(defmacro maybe-do-not-silence-errors (&body body)
  `(if *silence-plain-compilation-errors-p*
       ,@body
       (let ((ok nil))
         (unwind-protect
              (multiple-value-prog1
                  (call-next-method)
                (setf ok t))
           (unless ok (setf (status result) :failed))))))

;; macroexpand:
(if *silence-plain-compilation-errors-p* (handler-case (call-next-method) (error (err) (setf (value result) (if (typep result (quote multiple-value-result)) (list err) err)) (setf (status result) :failed))) (let ((ok nil)) (unwind-protect (multiple-value-prog1 (call-next-method) (setf ok t)) (unless ok (setf (status result) :failed)))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-hook-type any (function (&rest t)) "Hook accepting any arguments and returning anything.")

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

(define-hook-type any (function (&rest t)) "Hook accepting any arguments and returning anything.")

[Assistant]
(defmacro define-hook-type (name type &optional documentation)
  "Define hook class.
Type must be something like:

  (function (string) (values integer t))

The `handler-type' of the defined hook class has `:class' allocation
type, so that all hooks of such class have the same `handler-type'."
  (let* ((name (string name))
         (hook-class-name (intern (serapeum:concat "HOOK-" name))))
    `(defclass ,hook-class-name (hook)
       ((handler-type :initform ',type :allocation :class))
       (:metaclass closer-mop:funcallable-standard-class)
       ,@(when documentation
           `((:documentation ,documentation))))))

;; macroexpand:
(defclass hook-any (hook) ((handler-type :initform (quote (function (&rest t))) :allocation :class)) (:metaclass sb-mop:funcallable-standard-class) (:documentation "Hook accepting any arguments and returning anything."))


[User]
Write a Common Lisp macro to handle this code pattern:
(n-spaces *indent*)

Problem: Macro call that should be transformed by n-spaces

(n-spaces *indent*)

[Assistant]
(defmacro n-spaces (n)
  "A string with N spaces - used by indentation."
  `(make-array ,n
               :element-type 'base-char
               :displaced-to +spaces+
               :displaced-index-offset 0))

;; macroexpand:
(make-array *indent* :element-type (quote base-char) :displaced-to +spaces+ :displaced-index-offset 0)


[User]
Generate a defmacro form that transforms code like this:
(ematch0 parsed1 ((list slot pattern) (let (effslot reader) (cond ((setf effslot (find-effective-slot slot type)) `((slot-value ,it ',(c2mop:slot-definition-name effslot)) ,pattern)) ((setf reader (find-reader slot type)) `((,reader ,it) ,pattern)) (t (error "Failed to deduce the way to access the slot ~s" slot))))))

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

(ematch0 parsed1 ((list slot pattern) (let (effslot reader) (cond ((setf effslot (find-effective-slot slot type)) `((slot-value ,it ',(c2mop:slot-definition-name effslot)) ,pattern)) ((setf reader (find-reader slot type)) `((,reader ,it) ,pattern)) (t (error "Failed to deduce the way to access the slot ~s" slot))))))

[Assistant]
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

;; macroexpand:
(match0 parsed1 ((list slot pattern) (let (effslot reader) (cond ((setf effslot (find-effective-slot slot type)) (sb-int:quasiquote ((slot-value #S(sb-impl::comma :expr it :kind 0) (quote #S(sb-impl::comma :expr (sb-mop:slot-definition-name effslot) :kind 0))) #S(sb-impl::comma :expr pattern :kind 0)))) ((setf reader (find-reader slot type)) (sb-int:quasiquote ((#S(sb-impl::comma :expr reader :kind 0) #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr pattern :kind 0)))) (t (error "Failed to deduce the way to access the slot ~s" slot))))) (_ (error "level0 match error!")))


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

Problem: Macro call that should be transformed by DEFMETHOD*

(defmethod* nil (progn))

[Assistant]
(defmacro DEFMETHOD* ...)

;; macroexpand:
(let* ((#:nil127 (ensure-generic*-function 'nil))
       (temp-method (defmethod #:nil126 (progn)))
       (actual-gf
        (ensure-generic*-function 'nil :lambda-list
                                  (sb-mop:generic-function-lambda-list
                                   (symbol-function '#:nil126))
                                  :special-variables 'nil))
       (actual-method
        (add-method* #:nil127
                     (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 #:nil127)
           (ignore actual-gf))
  (setf (documentation actual-method t) (documentation temp-method t))
  actual-method)


[User]
Define a macro that eliminates this repetitive pattern:
(with-wcs-math-error-handling (ret (hypot x y)) (check-wcs-math-result))

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

(with-wcs-math-error-handling (ret (hypot x y)) (check-wcs-math-result))

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

;; macroexpand:
(let* ((#:g236 x) (#:g237 y) (#:g238 (list #:g236 #:g237))) (declare (ignorable #:g237) (type list #:g238) (dynamic-extent #:g238)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote hypot) #:g238) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g238)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defgenerator take-as-generator (n generator &key (fail-if-short t)) "This function has the same meaning as TAKE but returns a generator instead of a list. Eg: (generator->list (take-as-generator 10 (list->generator '(1 2 3)))) -> Signals a condition (generator->list (take-as-generator 10 (list->generator '(1 2 3)) :fail-if-short nil)) -> (1 2 3) (generator->list (take-as-generator 3 (repeat 1))) -> (1 1 1)" (declare (type (integer 1) n)) (let ((count 0)) (do-generator (g generator) (yield g) (incf count) (when (= count n) (yield 'generator-stop)))) (when fail-if-short (error 'insufficient-items :format-control "Insufficient items in generator")))

Problem: Macro call that should be transformed by defgenerator

(defgenerator take-as-generator (n generator &key (fail-if-short t)) "This function has the same meaning as TAKE but returns a generator instead of a list. Eg: (generator->list (take-as-generator 10 (list->generator '(1 2 3)))) -> Signals a condition (generator->list (take-as-generator 10 (list->generator '(1 2 3)) :fail-if-short nil)) -> (1 2 3) (generator->list (take-as-generator 3 (repeat 1))) -> (1 1 1)" (declare (type (integer 1) n)) (let ((count 0)) (do-generator (g generator) (yield g) (incf count) (when (= count n) (yield 'generator-stop)))) (when fail-if-short (error 'insufficient-items :format-control "Insufficient items in generator")))

[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 take-as-generator (n generator &key (fail-if-short t)) "This function has the same meaning as TAKE but returns a generator instead of a list. Eg: (generator->list (take-as-generator 10 (list->generator '(1 2 3)))) -> Signals a condition (generator->list (take-as-generator 10 (list->generator '(1 2 3)) :fail-if-short nil)) -> (1 2 3) (generator->list (take-as-generator 3 (repeat 1))) -> (1 1 1)" (declare (type (integer 1) n)) (with-yield (let ((count 0)) (do-generator (g generator) (yield g) (incf count) (when (= count n) (yield (quote generator-stop))))) (when fail-if-short (error (quote insufficient-items) :format-control "Insufficient items in generator"))))


[User]
Write a Common Lisp macro to handle this code pattern:
(make-instance* 'class () (apply-form))

Problem: Macro call that should be transformed by make-instance*

(make-instance* 'class () (apply-form))

[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) (apply-form))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(compile-$flavor-$methods)

Write a macro that addresses: Macro call that should be transformed by COMPILE-$FLAVOR-$METHODS

(compile-$flavor-$methods)

[Assistant]
(defmacro COMPILE-$FLAVOR-$METHODS ...)

;; macroexpand:
(eval-when (:load-toplevel) (combine-class-methods))


[User]
Define a macro that eliminates this repetitive pattern:
(fail (error "An expected failure."))

Issue: Macro call that should be transformed by fail

(fail (error "An expected failure."))

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(disable-version-syntax)

Problem: Macro call that should be transformed by disable-version-syntax

(disable-version-syntax)

[Assistant]
(defmacro disable-version-syntax ()
  "Restore readtable which was active before last call to
ENABLE-VERSION-SYNTAX. If there was no such call, the standard
readtable is used."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (%disable-version-syntax)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (%disable-version-syntax))


[User]
Write a Common Lisp macro to handle this code pattern:
(sctypecase (car x) (symbol (setf it 'symbol)) (bit (setf it 'bit)))

Problem: Macro call that should be transformed by sctypecase

(sctypecase (car x) (symbol (setf it 'symbol)) (bit (setf it 'bit)))

[Assistant]
(defmacro sctypecase (keyform &body cases)
  "Like CTYPECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for
the scope of the cases. IT can be set with SETF."
  `(symbolic ctypecase ,keyform ,@cases))

;; macroexpand:
(symbolic ctypecase (car x) (symbol (setf it (quote symbol))) (bit (setf it (quote bit))))


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

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

(psetq nil (progn))

[Assistant]
(defmacro PSETQ ...)

;; macroexpand:
(progn (setq nil (progn)) nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(psetf nil nil)

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

(psetf nil nil)

[Assistant]
(defmacro PSETF ...)

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-fixture-capture function (symbol) (when (and (fboundp symbol) (not (macro-function symbol)) (not (locked-package-p (symbol-package symbol)))) (values (fdefinition symbol) T)))

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

(define-fixture-capture function (symbol) (when (and (fboundp symbol) (not (macro-function symbol)) (not (locked-package-p (symbol-package symbol)))) (values (fdefinition symbol) T)))

[Assistant]
(defmacro define-fixture-capture (name args &body body)
  `(progn (setf (gethash ',name *fixture-captures*)
                (lambda ,args ,@body))
          ',name))

;; macroexpand:
(progn (setf (gethash (quote function) *fixture-captures*) (lambda (symbol) (when (and (fboundp symbol) (not (macro-function symbol)) (not (locked-package-p (symbol-package symbol)))) (values (fdefinition symbol) t)))) (quote function))


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

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

(defobject-amendment nil)

[Assistant]
(defmacro DEFOBJECT-AMENDMENT ...)

;; macroexpand:
(defobject nil
    (standard-object))


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

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

(gather-next nil (progn))

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

;; macroexpand:
(common-lisp:funcall nil (progn) nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(with-wrap-attempt () name (let* ((return-type (ensure-type return-type "function ~S (nee ~S) with return type ~S" name c-symbol return-type)) (fun (make-instance 'foreign-function :name name :c-symbol c-symbol :type return-type :variadic-p variadic-p))) (setf (foreign-record-fields fun) (loop for param in params collect (make-instance 'foreign-field :name (car param) :type (ensure-type (cadr param) "function ~S (nee ~S) due to parameter ~S of type ~S" name c-symbol (car param) (cadr param))))) (setf (gethash name *foreign-functions*) fun)))

Problem: Macro call that should be transformed by with-wrap-attempt

(with-wrap-attempt () name (let* ((return-type (ensure-type return-type "function ~S (nee ~S) with return type ~S" name c-symbol return-type)) (fun (make-instance 'foreign-function :name name :c-symbol c-symbol :type return-type :variadic-p variadic-p))) (setf (foreign-record-fields fun) (loop for param in params collect (make-instance 'foreign-field :name (car param) :type (ensure-type (cadr param) "function ~S (nee ~S) due to parameter ~S of type ~S" name c-symbol (car param) (cadr param))))) (setf (gethash name *foreign-functions*) fun)))

[Assistant]
(defmacro with-wrap-attempt ((&optional format-control &rest format-args) wrappable-name &body body)
  `(call-with-wrap-attempt ,wrappable-name (lambda () ,@body) ,format-control (list ,@format-args)))

;; macroexpand:
(call-with-wrap-attempt name (lambda nil (let* ((return-type (ensure-type return-type "function ~S (nee ~S) with return type ~S" name c-symbol return-type)) (fun (make-instance (quote foreign-function) :name name :c-symbol c-symbol :type return-type :variadic-p variadic-p))) (setf (foreign-record-fields fun) (loop for param in params collect (make-instance (quote foreign-field) :name (car param) :type (ensure-type (cadr param) "function ~S (nee ~S) due to parameter ~S of type ~S" name c-symbol (car param) (cadr param))))) (setf (gethash name *foreign-functions*) fun))) nil (list))


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

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

(nlet nil
    nil)

[Assistant]
(defmacro NLET ...)

;; macroexpand:
(let* ())


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-unique-names (value coerced-value) `((,name (,value) (let ((,coerced-value (coerce ,value ',type))) (declare (type ,type ,coerced-value)) (when (or ,firstp (> ,coerced-value ,var)) (setq ,var ,coerced-value ,firstp nil))))))

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

(with-unique-names (value coerced-value) `((,name (,value) (let ((,coerced-value (coerce ,value ',type))) (declare (type ,type ,coerced-value)) (when (or ,firstp (> ,coerced-value ,var)) (setq ,var ,coerced-value ,firstp nil))))))

[Assistant]
(defmacro with-unique-names (names &body body)
  `(let ,(mapcar (lambda (sym)
                   `(,sym (gensym ,(symbol-name sym))))
                  names)
     ,@body))

;; macroexpand:
(let ((value (gensym #A((5) base-char . "VALUE"))) (coerced-value (gensym #A((14) base-char . "COERCED-VALUE-")))) (quasiquote ((#S(sb-impl::comma :expr name :kind 0) (#S(sb-impl::comma :expr value :kind 0)) (let ((#S(sb-impl::comma :expr coerced-value :kind 0) (coerce #S(sb-impl::comma :expr value :kind 0) (quote #S(sb-impl::comma :expr type :kind 0))))) (declare (type #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr coerced-value :kind 0))) (when (or #S(sb-impl::comma :expr firstp :kind 0) (> #S(sb-impl::comma :expr coerced-value :kind 0) #S(sb-impl::comma :expr var :kind 0))) (setq #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr coerced-value :kind 0) #S(sb-impl::comma :expr firstp :kind 0) nil)))))))


[User]
Generate a defmacro form that transforms code like this:
(with-local-readtable
  nil
  (progn))

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

(with-local-readtable
  nil
  (progn))

[Assistant]
(defmacro WITH-LOCAL-READTABLE ...)

;; macroexpand:
(bind ((*readtable* (copy-readtable *readtable*)))
  nil
  (progn))


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

Write a macro that addresses: Macro call that should be transformed by DEFINE-ABSTRACT-CLASS

(define-abstract-class nil :key nil)

[Assistant]
(defmacro DEFINE-ABSTRACT-CLASS ...)

;; macroexpand:
(defclass nil :key nil (:metaclass abstract-class))


[User]
Write a Common Lisp macro to handle this code pattern:
(augment finalp-code finalp)

Problem: Macro call that should be transformed by augment

(augment finalp-code finalp)

[Assistant]
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))

;; macroexpand:
(setf finalp-code (nconc finalp-code finalp))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-value-binding across (var vector &aux (i 0) (length (length vector))) (declare (type vector vector) (type (integer 0) i length)) `(cond ((= ,length ,i) (end-for)) (T (update ,var (aref ,vector ,i)) (incf ,i))))

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

(define-value-binding across (var vector &aux (i 0) (length (length vector))) (declare (type vector vector) (type (integer 0) i length)) `(cond ((= ,length ,i) (end-for)) (T (update ,var (aref ,vector ,i)) (incf ,i))))

[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 across (var vector) (let ((#:i141 (gensym #A((1) base-char . "I"))) (#:length142 (gensym #A((6) base-char . "LENGTH"))) (#:vector140 (gensym #A((6) base-char . "VECTOR")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:vector140 vector) (list #:i141 0) (list #:length142 (list (quote length) #:vector140)) (loop for #:var139 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var139 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:i141 :kind 0) #S(sb-impl::comma :expr #:length142 :kind 0) #S(sb-impl::comma :expr #:vector140 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote vector) :kind 0) #S(sb-impl::comma :expr #:vector140 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (integer 0)) :kind 0) #S(sb-impl::comma :expr #:i141 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (integer 0)) :kind 0) #S(sb-impl::comma :expr #:length142 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((i #:i141) (length #:length142) (vector #:vector140)) (declare (ignorable i length vector)) (sb-int:quasiquote (cond ((= #S(sb-impl::comma :expr length :kind 0) #S(sb-impl::comma :expr i :kind 0)) (end-for)) (t (update #S(sb-impl::comma :expr var :kind 0) (aref #S(sb-impl::comma :expr vector :kind 0) #S(sb-impl::comma :expr i :kind 0))) (incf #S(sb-impl::comma :expr i :kind 0)))))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(lambda-match ((list* :method args) (make-save-method args)) ((list* :method-combination name options) (setf combination name) (setf combination-options options)))

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

(lambda-match ((list* :method args) (make-save-method args)) ((list* :method-combination name options) (setf combination name) (setf combination-options options)))

[Assistant]
(defmacro lambda-match (&body clauses)
  (with-gensyms (args)
    `(lambda (,args)
       (match ,args
	 ,@clauses))))

;; macroexpand:
(lambda (#:args125) (match #:args125 ((list* :method args) (make-save-method args)) ((list* :method-combination name options) (setf combination name) (setf combination-options options))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (when (slot-value report 'description) (format/indent reporter stream (concatenate 'string "~&" (report-expected-line report))))) (terpri stream))

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

(with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (when (slot-value report 'description) (format/indent reporter stream (concatenate 'string "~&" (report-expected-line report))))) (terpri stream))

[Assistant]
(defmacro with-color ((color &rest args) &body body)
  (cond
    ((or (eq color :gray)
         (eq color :grey))
     `(if *enable-colors*
          (with-gray ,(or (getf args :stream) t) ,@body)
          (progn ,@body)))
    (T `(if *enable-colors*
            (if (or (eq ,color :gray)
                    (eq ,color :grey)
                    (eq ,color cl-colors:+gray+)
                    (eq ,color cl-colors:+grey+))
                (with-gray ,(or (getf args :stream) t) ,@body)
                (cl-ansi-text:with-color (,color ,@args) ,@body))
            (progn ,@body)))))

;; macroexpand:
(if *enable-colors* (if (or (eq :red :gray) (eq :red :grey) (eq :red +gray+) (eq :red +grey+)) (with-gray stream (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report (quote duration)))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report (quote slow-threshold))))) (when (slot-value report (quote description)) (format/indent reporter stream (concatenate (quote string) "~&" (report-expected-line report))))) (terpri stream)) (cl-ansi-text:with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report (quote duration)))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report (quote slow-threshold))))) (when (slot-value report (quote description)) (format/indent reporter stream (concatenate (quote string) "~&" (report-expected-line report))))) (terpri stream))) (progn (with-additional-indent (reporter stream "× ") (let ((description (possible-report-description report)) (duration (slot-value report (quote duration)))) (when description (format/indent reporter stream description)) (when duration (format stream " ") (print-duration stream duration (slot-value report (quote slow-threshold))))) (when (slot-value report (quote description)) (format/indent reporter stream (concatenate (quote string) "~&" (report-expected-line report))))) (terpri stream)))


[User]
Write a Common Lisp macro to handle this code pattern:
(path (gensym "path"))

Problem: Macro call that should be transformed by path

(path (gensym "path"))

[Assistant]
(defmacro path (&body cmds)
  (let ((path (gensym "path")))
    `(let ((,path (make-path)))
       (with-path ,path
         ,@cmds)
       ,path)))

;; macroexpand:
(let ((#:|path140| (make-path))) (with-path #:|path140| (gensym "path")) #:|path140|)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(dynamic-let* 'some-name)

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

(dynamic-let* 'some-name)

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

;; macroexpand:
(dynamic-let (quote)
  (dynamic-let* (some-name)))


[User]
Write a Common Lisp macro to handle this code pattern:
(inext 'some-name)

Problem: Macro call that should be transformed by INEXT

(inext 'some-name)

[Assistant]
(defmacro INEXT ...)

;; macroexpand:
(let ((vals (multiple-value-list (funcall (i-coro 'some-name) nil))))
  (if (not vals)
      (coexit!)
      (car vals)))


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

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

(ps-html)

[Assistant]
(defmacro PS-HTML ...)

;; macroexpand:
(stringify)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "~A~:[~; AFTER ~:*~A~]~:[~; FIRST~]" (call-next-method) (and (column-modifier-clause-after clause) (yield (column-modifier-clause-after clause))) (column-modifier-clause-first clause)))

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

(with-yield-binds (format nil "~A~:[~; AFTER ~:*~A~]~:[~; FIRST~]" (call-next-method) (and (column-modifier-clause-after clause) (yield (column-modifier-clause-after clause))) (column-modifier-clause-first clause)))

[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 (format nil "~A~:[~; AFTER ~:*~A~]~:[~; FIRST~]" (call-next-method) (and (column-modifier-clause-after clause) (yield (column-modifier-clause-after clause))) (column-modifier-clause-first clause))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-unique-names (value coerced-value) `((,name (,value) (let ((,coerced-value (coerce ,value ',type))) (declare (type ,type ,coerced-value)) (when (or ,firstp (< ,coerced-value ,var)) (setq ,var ,coerced-value ,firstp nil))))))

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

(with-unique-names (value coerced-value) `((,name (,value) (let ((,coerced-value (coerce ,value ',type))) (declare (type ,type ,coerced-value)) (when (or ,firstp (< ,coerced-value ,var)) (setq ,var ,coerced-value ,firstp nil))))))

[Assistant]
(defmacro with-unique-names (names &body body)
  `(let ,(mapcar (lambda (sym)
                   `(,sym (gensym ,(symbol-name sym))))
                  names)
     ,@body))

;; macroexpand:
(let ((value (gensym #A((5) base-char . "VALUE"))) (coerced-value (gensym #A((14) base-char . "COERCED-VALUE-")))) (quasiquote ((#S(sb-impl::comma :expr name :kind 0) (#S(sb-impl::comma :expr value :kind 0)) (let ((#S(sb-impl::comma :expr coerced-value :kind 0) (coerce #S(sb-impl::comma :expr value :kind 0) (quote #S(sb-impl::comma :expr type :kind 0))))) (declare (type #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr coerced-value :kind 0))) (when (or #S(sb-impl::comma :expr firstp :kind 0) (< #S(sb-impl::comma :expr coerced-value :kind 0) #S(sb-impl::comma :expr var :kind 0))) (setq #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr coerced-value :kind 0) #S(sb-impl::comma :expr firstp :kind 0) nil)))))))


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

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

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

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

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


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

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

(or)

[Assistant]
(defmacro OR ...)

;; macroexpand:
nil


[User]
Generate a defmacro form that transforms code like this:
(define-shell-component ditaa :input-type "ditaa" :output-type "png" :shell-command "ditaa")

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

(define-shell-component ditaa :input-type "ditaa" :output-type "png" :shell-command "ditaa")

[Assistant]
(defmacro define-shell-component (name &key input-type output-type shell-command)
  "Define an ASDF component that's compiled by running a shell command."
  `(define-component ,name
     :input-type ,input-type
     :output-type ,output-type
     :compile-function (lambda (input-pathname output-pathname)
                         (inferior-shell:run (list ,@(ensure-list shell-command)
                                                    input-pathname
                                                    output-pathname)
                                             :show t))))

;; macroexpand:
(define-component ditaa :input-type "ditaa" :output-type "png" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run (list "ditaa" input-pathname output-pathname) :show t)))


[User]
Generate a defmacro form that transforms code like this:
(signal-syntax-error* (+ open-paren-pos 2) "Opening paren has no matching closing paren.")

Pattern to recognize: Macro call that should be transformed by signal-syntax-error*

(signal-syntax-error* (+ open-paren-pos 2) "Opening paren has no matching closing paren.")

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

;; macroexpand:
(error (quote ppcre-syntax-error) :pos (+ open-paren-pos 2) :format-control "Opening paren has no matching closing paren." :format-arguments (list))


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

What needs to change: Macro call that should be transformed by USE-SYNTAX

(use-syntax nil)

[Assistant]
(defmacro use-syntax (name)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (%use-syntax ,name)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (%use-syntax nil))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-mustache-character #\& (make-instance 'ampersand-tag :text arg-text))

Problem: Macro call that should be transformed by define

(define-mustache-character #\& (make-instance 'ampersand-tag :text arg-text))

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

;; macroexpand:
(set-mustache-character #\AMPERSAND (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (make-instance (quote ampersand-tag) :text arg-text)))


[User]
Generate a defmacro form that transforms code like this:
(define-simple-definition-resolver function designator-function-p)

Pattern to recognize: Macro call that should be transformed by define-simple-definition-resolver

(define-simple-definition-resolver function designator-function-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 function (function #:package133) (when (ignore-errors (designator-function-p function)) (list (make-instance (quote function) :designator function :package #:package133))))


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

Issue: Macro call that should be transformed by LAMBDA*

(lambda* nil)

[Assistant]
(defmacro LAMBDA* ...)

;; macroexpand:
(lambda () (with-yield))


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

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

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

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-library compression-lib)

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

(define-library compression-lib)

[Assistant]
(defmacro define-library (name &body initargs)
  #+cffi
  `(change-class (cffi::get-foreign-library ',name)
                 'library
                 ,@initargs)
  #-cffi
  `(make-instance 'library ,@initargs))

;; macroexpand:
(change-class (cffi::get-foreign-library (quote compression-lib)) (quote library))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-simple-type-map function cl:function)

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

(define-simple-type-map function cl:function)

[Assistant]
(defmacro define-simple-type-map (class type)
  `(defmethod type ((,class ,class))
     ',type))

;; macroexpand:
(defmethod type ((function function)) (quote common-lisp:function))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(*> +comma+ +consume-space+)

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

(*> +comma+ +consume-space+)

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

;; macroexpand:
(lambda (#:*>-offset172) (multiple-value-bind (#:*>-res173 #:*>-next174) (funcall +comma+ #:*>-offset172) (if (ok? #:*>-res173) (funcall +consume-space+ #:*>-next174) (fail #:*>-next174))))


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

What needs to change: Macro call that should be transformed by MATRIX-CASE

(matrix-case nil)

[Assistant]
(defmacro MATRIX-CASE ...)

;; macroexpand:
nil


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

Write a macro that addresses: Macro call that should be transformed by WITH-INACTIVE-LAYERS

(with-inactive-layers nil
  :key
  nil)

[Assistant]
(defmacro WITH-INACTIVE-LAYERS ...)

;; macroexpand:
(progn :key nil)


[User]
Define a macro that eliminates this repetitive pattern:
(with-wcs-math-error-handling (ret (log1+ x)) (check-wcs-math-result))

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

(with-wcs-math-error-handling (ret (log1+ x)) (check-wcs-math-result))

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

;; macroexpand:
(let* ((#:g227 x) (#:g228 nil) (#:g229 (list #:g227))) (declare (ignorable #:g228) (type list #:g229) (dynamic-extent #:g229)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote log1+) #:g229) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g229)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-table node hash depth (bitmap array bits index hit) (when hit (%hamt-lookup (aref array index) key hash (1+ depth) test)))

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

(with-table node hash depth (bitmap array bits index hit) (when hit (%hamt-lookup (aref array index) key hash (1+ depth) test)))

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

;; macroexpand:
(let* ((bitmap (table-bitmap node)) (array (table-array node)) (bits (get-bits hash depth)) (index (get-index bits bitmap)) (hit (logbitp bits bitmap))) (when hit (%hamt-lookup (aref array index) key hash (1+ depth) test)))


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

Issue: Macro call that should be transformed by receive

(receive x (values) x)

[Assistant]
(defmacro receive (formals expr &body body)
  "Stricter version of `multiple-value-bind'.

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

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

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

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

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

;; macroexpand:
(multiple-value-call (lambda (&rest x) x) (values))


[User]
Write a Common Lisp macro to handle this code pattern:
(yield-all (flatten (car list)))

Problem: Macro call that should be transformed by yield-all

(yield-all (flatten (car list)))

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

;; macroexpand:
(do-generator (#:g184 (flatten (car list))) (yield #:g184))