Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-api merge-readtables-into (result-readtable &rest named-readtables) (named-readtable-designator &rest named-readtable-designator => readtable) "Copy macro character definitions of each readtable in NAMED-READTABLES into RESULT-READTABLE. If a macro character appears in more than one of the readtables, i.e. if a conflict is discovered during the merge, an error of type READER-MACRO-CONFLICT is signaled. The copied options are :DISPATCH-MACRO-CHAR, :MACRO-CHAR and :SYNTAX-FROM, but not READTABLE-CASE." (flet ((merge-into (to from) (do-readtable ((char reader-fn non-terminating-p disp? table) from) (check-reader-macro-conflict from to char) (cond ((not disp?) (set-macro-character char reader-fn non-terminating-p to)) (t (ensure-dispatch-macro-character char non-terminating-p to) (loop for (subchar . subfn) in table do (check-reader-macro-conflict from to char subchar) (set-dispatch-macro-character char subchar subfn to))))) to)) (let ((result-table (ensure-readtable result-readtable))) (dolist (table (mapcar #'ensure-readtable named-readtables)) (merge-into result-table table)) result-table)))

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

Input: (define-api merge-readtables-into (result-readtable &rest named-readtables) (named-readtable-designator &rest named-readtable-designator => readtable) "Copy macro character definitions of each readtable in NAMED-READTABLES into RESULT-READTABLE. If a macro character appears in more than one of the readtables, i.e. if a conflict is discovered during the merge, an error of type READER-MACRO-CONFLICT is signaled. The copied options are :DISPATCH-MACRO-CHAR, :MACRO-CHAR and :SYNTAX-FROM, but not READTABLE-CASE." (flet ((merge-into (to from) (do-readtable ((char reader-fn non-terminating-p disp? table) from) (check-reader-macro-conflict from to char) (cond ((not disp?) (set-macro-character char reader-fn non-terminating-p to)) (t (ensure-dispatch-macro-character char non-terminating-p to) (loop for (subchar . subfn) in table do (check-reader-macro-conflict from to char subchar) (set-dispatch-macro-character char subchar subfn to))))) to)) (let ((result-table (ensure-readtable result-readtable))) (dolist (table (mapcar #'ensure-readtable named-readtables)) (merge-into result-table table)) result-table)))

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

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

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

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

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

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

(progn (declaim (ftype (function (named-readtable-designator &rest named-readtable-designator) (values readtable &optional)) merge-readtables-into)) (locally (declare (sb-ext:muffle-conditions style-warning)) (defun merge-readtables-into (result-readtable &rest named-readtables) "Copy macro character definitions of each readtable in NAMED-READTABLES into RESULT-READTABLE. If a macro character appears in more than one of the readtables, i.e. if a conflict is discovered during the merge, an error of type READER-MACRO-CONFLICT is signaled. The copied options are :DISPATCH-MACRO-CHAR, :MACRO-CHAR and :SYNTAX-FROM, but not READTABLE-CASE." (locally (declare (sb-ext:unmuffle-conditions style-warning)) (flet ((merge-into (to from) (do-readtable ((char reader-fn non-terminating-p disp? table) from) (check-reader-macro-conflict from to char) (cond ((not disp?) (set-macro-character char reader-fn non-terminating-p to)) (t (ensure-dispatch-macro-character char non-terminating-p to) (loop for (subchar . subfn) in table do (check-reader-macro-conflict from to char subchar) (set-dispatch-macro-character char subchar subfn to))))) to)) (let ((result-table (ensure-readtable result-readtable))) (dolist (table (mapcar (function ensure-readtable) named-readtables)) (merge-into result-table table)) result-table))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-modf-rewrite cddddr (expr) `(cdr (cdddr ,(second expr))))

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

Input: (define-modf-rewrite cddddr (expr) `(cdr (cdddr ,(second expr))))

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
($map-reduce "foo" m r :out "testit" :query ($> "l" -900) :limit 2)

Issue: Macro call that should be transformed by $map-reduce

Input: ($map-reduce "foo" m r :out "testit" :query ($> "l" -900) :limit 2)

Output:
(defmacro $map-reduce (collection map reduce &key (query nil) (limit 0) (out nil)
		       (keeptemp nil) (finalize nil) (verbose t))
  "Run map reduce on the mongo server. map and reduce are either the names of the
javascript functions, created with defjs or defsrvjs or are function definitions in javascript.
The keywords refer to option available for map reduce in mongo. This returns a result summary document.
When using :keeptemp t without specificing :out the collection is mr.<collection> "
    `(db.find "$cmd" (kv (kv "mapreduce" ,collection)
			 (kv "map"    (or (jsdef ,map) ',map))
			 (kv "reduce" (or (jsdef ,reduce) ',reduce))
			 (when ,finalize (kv "finalize" (jsdef ,finalize)))
			 (kv "out"      (if ,out ,out (concatenate 'string "mr." ,collection)))
			 (kv "verbose"  ,verbose)
			 (kv "limit"    ,limit)
			 (kv "keeptemp" ,keeptemp)
			 (kv "query"    ,query))))

(db.find "$cmd" (kv (kv "mapreduce" "foo") (kv "map" (or (jsdef m) (quote m))) (kv "reduce" (or (jsdef r) (quote r))) (when nil (kv "finalize" (jsdef nil))) (kv "out" (if "testit" "testit" (concatenate (quote string) "mr." "foo"))) (kv "verbose" t) (kv "limit" 2) (kv "keeptemp" nil) (kv "query" ($> "l" -900))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(ct-let* nil)

Issue: Macro call that should be transformed by CT-LET*

Input: (ct-let* nil)

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

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


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

Problem: Macro call that should be transformed by DEFMACRO*

Input:
(defmacro* nil
    nil)

Output: (defmacro DEFMACRO* ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvar-unbound *saw-backslash* "Whether we have to re-process an \L or \U because it closes several scopes.")

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

Input: (defvar-unbound *saw-backslash* "Whether we have to re-process an \L or \U because it closes several scopes.")

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

(eval-when (:load-toplevel :compile-toplevel :execute) (defvar *saw-backslash*) (setf (documentation (quote *saw-backslash*) (quote variable)) "Whether we have to re-process an L or U because it closes several scopes."))


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

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

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

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

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


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

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

Input: (collect-sum nil)

Output: (defmacro COLLECT-SUM ...)

(common-lisp:let* ((#:generator-236 (generator nil))
                   #:numbers-232
                   (#:sum-233 0))
  (declare (type generator #:generator-236)
           (type number #:sum-233))
  (tagbody
   #:ll-237
    (setq #:numbers-232 (next-in #:generator-236 (go end)))
    (setq #:sum-233 (+ #:sum-233 #:numbers-232))
    (go #:ll-237)
   end)
  #:sum-233)


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

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

Input: (defsynonym always :always)

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

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


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

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

Input:
(defun* nil
    nil)

Output: (defmacro DEFUN* ...)

(progn (declaim (ftype (function nil t) nil)) (defun nil (the t ())))


Instruction:
Generate a defmacro form that transforms code like this:
(dict-of nil nil)

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

Input: (dict-of nil nil)

Output: (defmacro DICT-OF ...)

(let ((#:dict125 (make-hash-table :test 'equal)))
  (do-for (nil)
    (multiple-value-call
        (lambda (#:k126 #:v127) (setf (gethash #:k126 #:dict125) #:v127))
      nil))
  #:dict125)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(deferror "42703" undefined-column syntax-error-or-access-violation)

Problem: Macro call that should be transformed by deferror

Input: (deferror "42703" undefined-column syntax-error-or-access-violation)

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time cps-convert-let* (bindings body declarations continuation types value? environment) (if (null bindings) (if (null declarations) (cps-convert-progn body continuation types value? environment) `(let () ,@declarations ,(cps-convert-progn body continuation types value? environment))) (let* ((binding (first bindings)) (binding-variable (if (symbolp binding) binding (first binding))) (binding-form (if (and (consp binding) (= (length binding) 2)) (second binding) nil)) (other-arguments (gensym "OTHER-"))) (cps-convert binding-form `#'(lambda (&optional ,binding-variable &rest ,other-arguments) (declare (magic) (ignore ,other-arguments)) ,(cps-convert-let* (rest bindings) body declarations continuation types value? environment)) '() t environment))))

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

Input: (defun-compile-time cps-convert-let* (bindings body declarations continuation types value? environment) (if (null bindings) (if (null declarations) (cps-convert-progn body continuation types value? environment) `(let () ,@declarations ,(cps-convert-progn body continuation types value? environment))) (let* ((binding (first bindings)) (binding-variable (if (symbolp binding) binding (first binding))) (binding-form (if (and (consp binding) (= (length binding) 2)) (second binding) nil)) (other-arguments (gensym "OTHER-"))) (cps-convert binding-form `#'(lambda (&optional ,binding-variable &rest ,other-arguments) (declare (magic) (ignore ,other-arguments)) ,(cps-convert-let* (rest bindings) body declarations continuation types value? environment)) '() t environment))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun cps-convert-let* (bindings body declarations continuation types value? environment) (if (null bindings) (if (null declarations) (cps-convert-progn body continuation types value? environment) (sb-int:quasiquote (let nil #S(sb-impl::comma :expr declarations :kind 2) #S(sb-impl::comma :expr (cps-convert-progn body continuation types value? environment) :kind 0)))) (let* ((binding (first bindings)) (binding-variable (if (symbolp binding) binding (first binding))) (binding-form (if (and (consp binding) (= (length binding) 2)) (second binding) nil)) (other-arguments (gensym "OTHER-"))) (cps-convert binding-form (sb-int:quasiquote (function (lambda (&optional #S(sb-impl::comma :expr binding-variable :kind 0) &rest #S(sb-impl::comma :expr other-arguments :kind 0)) (declare (magic) (ignore #S(sb-impl::comma :expr other-arguments :kind 0))) #S(sb-impl::comma :expr (cps-convert-let* (rest bindings) body declarations continuation types value? environment) :kind 0)))) (quote nil) t environment)))) (eval-when (:compile-toplevel) (compile (quote cps-convert-let*))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-op (:* conjunctive-op))

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

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

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

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


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

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

Input: (enable-syntax)

Output:
(defmacro enable-syntax ()
  '(in-readtable datafly-syntax))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(bind (((:plist (start _ 0) end (fuzz fuzziness 'no)) plist)) (list start end fuzz))

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

Input: (bind (((:plist (start _ 0) end (fuzz fuzziness 'no)) plist)) (list start end fuzz))

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

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

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

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

(let* ((#:|values-163| plist) (start (getf #:|values-163| :start 0)) (end (getf #:|values-163| :end)) (fuzz (getf #:|values-163| :fuzziness (quote no)))) (declare (ignorable #:|values-163|)) (progn (list start end fuzz)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is eql a 'c)

Problem: Macro call that should be transformed by is

Input: (is eql a 'c)

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (is eql a (quote c))) :value-form (quote (quote c)) :body (lambda nil (quote c)) :expected a :comparison (quote eql)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-custom-var (:internal-decoder *internal-decoder*) 'decode-json "Designator for a function of 1 stream argument called (instead of DECODE-JSON) to decode a member of an Array or of an Object.")

Problem: Macro call that should be transformed by define-custom-var

Input: (define-custom-var (:internal-decoder *internal-decoder*) 'decode-json "Designator for a function of 1 stream argument called (instead of DECODE-JSON) to decode a member of an Array or of an Object.")

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

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*internal-decoder* . :internal-decoder)) *custom-vars* :test (function equal)) (defvar *internal-decoder* (quote decode-json) "Designator for a function of 1 stream argument called (instead of DECODE-JSON) to decode a member of an Array or of an Object.")))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(enable-quasi-quoted-string-to-binary-emitting-form-syntax 'some-name)

Problem: Macro call that should be transformed by ENABLE-QUASI-QUOTED-STRING-TO-BINARY-EMITTING-FORM-SYNTAX

Input: (enable-quasi-quoted-string-to-binary-emitting-form-syntax 'some-name)

Output: (defmacro ENABLE-QUASI-QUOTED-STRING-TO-BINARY-EMITTING-FORM-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quoted-string-to-binary-emitting-form-syntax-in-readtable
   'some-name :with-inline-emitting nil :declarations 'nil :start-character nil
   :end-character nil :unquote-character #\COMMA :splice-character
   #\COMMERCIAL_AT :destructive-splice-character #\FULL_STOP
   :dispatched-quasi-quote-name "str" :encoding *default-character-encoding*)
  (values))


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

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

Input: (defpackage nil (progn))

Output: (defmacro DEFPACKAGE ...)

(common-lisp:defpackage nil
  (:use :adhoc :closer-mop :cl)
  (:shadowing-import-from :closer-mop
                          #:defmethod
                          #:standard-generic-function
                          #:defgeneric
                          #:standard-method
                          #:standard-class)
  (:shadowing-import-from :adhoc #:defpackage #:variable #:the)
  (progn))


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

Issue: Macro call that should be transformed by WITH-RULES

Input:
(with-rules nil
  :key
  nil)

Output: (defmacro WITH-RULES ...)

(dolist (nil (alexandria:hash-table-keys cl-rules.core::*rules*)) :key nil)


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

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

Input:
(some->>
  nil
  :key
  nil)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun/1 putchar (c) (fputc c stdout))

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

Input: (defun/1 putchar (c) (fputc c stdout))

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(matrix-case 'some-name)

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

Input: (matrix-case 'some-name)

Output: (defmacro MATRIX-CASE ...)


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

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

Input:
(defreply nil
    nil)

Output: (defmacro DEFREPLY ...)

(progn
 (eval-when (:compile-toplevel)
   (unless (fboundp 'nil)
     (warn 'automatic-message-creation :message-name 'nil)
     (ensure-message 'nil :lambda-list 'nil)))
 (ensure-reply 'nil :qualifiers 'nil :lambda-list 'nil :participants (list)
               :documentation nil :function
               (lambda (#:args136 #:next-replies137 &rest #:more-args139)
                 (declare
                  (ignorable #:args136 #:next-replies137 #:more-args139))
                 (flet ((next-reply-p ()
                          (not (null #:next-replies137)))
                        (call-next-reply (&rest args)
                          (if (null #:next-replies137)
                              (apply 'no-next-reply
                                     (getf #:more-args139 :message)
                                     (getf #:more-args139 :reply)
                                     (or args #:args136))
                              (apply (reply-function (car #:next-replies137))
                                     (or args #:args136)
                                     (cdr #:next-replies137) #:more-args139))))
                   (declare
                    (ignorable (function next-reply-p)
                     (function call-next-reply)))
                   (flet ((#:reply-function138 ()
                            (declare (ignorable))
                            (block nil)))
                     (declare (inline #:reply-function138))
                     (apply #'#:reply-function138 #:args136))))))


Instruction:
Generate a defmacro form that transforms code like this:
(*> #'integer (opt (*> (char #\.) (take-while1 #'digit?))))

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

Input: (*> #'integer (opt (*> (char #\.) (take-while1 #'digit?))))

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

(lambda (#:*>-offset215) (multiple-value-bind (#:*>-res216 #:*>-next217) (funcall (function integer) #:*>-offset215) (if (ok? #:*>-res216) (funcall (opt (*> (char #\FULL_STOP) (take-while1 (function digit?)))) #:*>-next217) (fail #:*>-next217))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-html-string (:xy "Hello"))

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

Input: (with-html-string (:xy "Hello"))

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

(with-output-to-string (*html*) (with-html (:xy "Hello")))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(maybe-once-only nil
  nil)

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

Input:
(maybe-once-only nil
  nil)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(flow-lambda-macro (flow-context) (with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu)))

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

Input: (flow-lambda-macro (flow-context) (with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu)))

Output:
(defmacro flow-lambda-macro ((flow-context) &body body)
  `(with-gensyms (,flow-context)
     `(%flow-lambda (,,flow-context)
        ,,@body)))

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


Instruction:
Generate a defmacro form that transforms code like this:
(define-element-maker :radial-gradient "radialGradient" '(:id :cx :cy :r))

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

Input: (define-element-maker :radial-gradient "radialGradient" '(:id :cx :cy :r))

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

(progn (defmethod assert-required-attributes ((element (eql :radial-gradient)) attributes) (declare (ignore element)) (unless (evenp (length attributes)) (warn "attribute list may be missing data: ~A" attributes)) (let ((missing (set-difference (quote (:id :cx :cy :r)) attributes))) (when missing (error (quote missing-attributes) :message (format nil "~A missing attributes: ~{~A~^ ~}" :radial-gradient missing))))) (defmethod make-svg-element ((element (eql :radial-gradient)) attributes) (when *check-required-attributes* (assert-required-attributes element attributes)) (make-instance (quote svg-element) :name "radialGradient" :attributes attributes)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-context (context) (process-response this result))

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

Input: (with-context (context) (process-response this result))

Output:
(defmacro with-context ((context) &body body)
  `(let* ((*context* ,context)
          (*request* (context :request))
          (*response* (context :response))
          (*session* (context :session)))
     ,@body))

(let* ((*context* context) (*request* (context :request)) (*response* (context :response)) (*session* (context :session))) (process-response this result))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun query-index ((type :node) name query) :get (:uri-spec (format nil "index/~A/~A/?query=~A" (string-downcase (symbol-name type)) name (urlencode query))) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'index-entry-not-found-error :uri uri))))

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

Input: (def-neo4j-fun query-index ((type :node) name query) :get (:uri-spec (format nil "index/~A/~A/?query=~A" (string-downcase (symbol-name type)) name (urlencode query))) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'index-entry-not-found-error :uri uri))))

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

(progn (defun query-index (&key (type :node) name query) (let ((uri (format nil "index/~A/~A/?query=~A" (string-downcase (symbol-name type)) name (urlencode query))) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 404 (lambda (body uri json) (error (quote index-entry-not-found-error) :uri uri))))))))


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

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

Input: (receive () (values) nil)

Output:
(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)))))

(multiple-value-call (lambda nil nil) (values))


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

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

Input:
(defmethod* nil
    :key
  nil)

Output: (defmacro DEFMETHOD* ...)


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

Issue: Macro call that should be transformed by SEND

Input: (send nil (progn))

Output: (defmacro SEND ...)

(send (funcall (slot-value nil 'progn)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-assert-observers ("deleting foo" foo foo+1) (store-remove :foo store))

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

Input: (with-assert-observers ("deleting foo" foo foo+1) (store-remove :foo store))

Output:
(defmacro with-assert-observers ((desc &rest asserted-observers) &body body)
  `(let ((*observers* nil))
     (trc ,desc " -- checking observers")
     ,@body
     (let ((superfluous-observers (loop for run in *observers* if (not (member run (list ,@asserted-observers))) collect run))
	   (failed-observers (loop for asserted in (list ,@asserted-observers) if (not (member asserted *observers*)) collect asserted)))
       (trc "called observers on" *observers* :superflous superfluous-observers :failed failed-observers)
       (assert (not superfluous-observers))
       (assert (not failed-observers)))))

(let ((*observers* nil)) (trc "deleting foo" " -- checking observers") (store-remove :foo store) (let ((superfluous-observers (loop for run in *observers* if (not (member run (list foo foo+1))) collect run)) (failed-observers (loop for asserted in (list foo foo+1) if (not (member asserted *observers*)) collect asserted))) (trc "called observers on" *observers* :superflous superfluous-observers :failed failed-observers) (assert (not superfluous-observers)) (assert (not failed-observers))))


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

Problem: Macro call that should be transformed by RETURN

Input: (return 'some-name)

Output: (defmacro RETURN ...)


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

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

Input: (reduced-typecase nil (progn))

Output: (defmacro REDUCED-TYPECASE ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(enable-fn-syntax)

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

Input: (enable-fn-syntax)

Output: (defmacro ENABLE-FN-SYNTAX ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(when (eql (top-sign) 'skip-first-template) (pop-sign))

Problem: Macro call that should be transformed by when

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(gen-lambda () (if (> i (1- seqlen)) 'generator-stop (prog1 (elt seq i) (incf i))))

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

Input: (gen-lambda () (if (> i (1- seqlen)) 'generator-stop (prog1 (elt seq i) (incf i))))

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

(let ((values-handler (create-values-handler))) (declare (ignorable values-handler)) (make-instance (quote basic-generator) :function (lambda nil (if (> i (1- seqlen)) (quote generator-stop) (prog1 (elt seq i) (incf i))))))


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

Issue: Macro call that should be transformed by DEFINE-LANGUAGE-MACRO

Input: (define-language-macro 'some-name)

Output: (defmacro DEFINE-LANGUAGE-MACRO ...)

(defmacro 'some-name (&whole whole &body body)
  (declare (ignore body))
  `(macrolet ((,(car whole) (&body body)
                (let* ((lang (make-instance ',(car whole)))
                       (env (top-level-environment lang)))
                  (codegen-text (sexp->ops lang body env) ,*pretty*))))
     ,@(if *pretty*
           `((let ((*text-pretty-printer* (get-pretty-printer)))
               ,whole))
           `(,whole))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do+ (options :name inner-loop) (do+ (terminate outer-loop 3)))

Problem: Macro call that should be transformed by do+

Input: (do+ (options :name inner-loop) (do+ (terminate outer-loop 3)))

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

(do+/internal nil (options :name inner-loop) (do+ (terminate outer-loop 3)))


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

Issue: Macro call that should be transformed by DYNAMIC-RELET*

Input: (dynamic-relet* 'some-name)

Output: (defmacro DYNAMIC-RELET* ...)

(dynamic-relet (quote)
  (dynamic-relet* (some-name)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-component coffee :input-type "coffee" :output-type "js" :compile-function (lambda (input-pathname output-pathname) (declare (ignore output-pathname)) (inferior-shell:run `("coffee" "-c" ,input-pathname) :show t)))

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

Input: (define-component coffee :input-type "coffee" :output-type "js" :compile-function (lambda (input-pathname output-pathname) (declare (ignore output-pathname)) (inferior-shell:run `("coffee" "-c" ,input-pathname) :show t)))

Output:
(defmacro define-component (name &key input-type output-type compile-function)
  "Define an ASDF component."
  `(progn
     (defclass ,name (source-file)
       ((type :initform ,input-type)
        (output :reader output :initarg :output)))

     (defmethod perform ((o load-op) (component ,name)) t)

     (defmethod output-files ((operation compile-op) (component ,name))
       (list
        (output-pathname component ,output-type)))

     (defmethod perform ((o compile-op) (component ,name))
       (funcall ,compile-function
                (component-pathname component)
                (output-pathname component ,output-type)))

     (import ',name :asdf)))

(progn (defclass coffee (source-file) ((type :initform "coffee") (output :reader output :initarg :output))) (defmethod perform ((o load-op) (component coffee)) t) (defmethod output-files ((operation compile-op) (component coffee)) (list (output-pathname component "js"))) (defmethod perform ((o compile-op) (component coffee)) (funcall (lambda (input-pathname output-pathname) (declare (ignore output-pathname)) (inferior-shell:run (sb-int:quasiquote ("coffee" "-c" #S(sb-impl::comma :expr input-pathname :kind 0))) :show t)) (component-pathname component) (output-pathname component "js"))) (import (quote coffee) :asdf))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is (= 4 d))

Problem: Macro call that should be transformed by is

Input: (is (= 4 d))

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

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

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

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

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

(let ((#:e277 4) (#:a278 d)) (if (progn (= #:e277 #:a278)) (add-result (quote test-passed) :test-expr (quote (= 4 d))) (process-failure (quote (= 4 d)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote d) #:a278 (quote =) #:e277)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-generator (d s (izip data selectors)) (when s (yield d)))

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

Input: (do-generator (d s (izip data selectors)) (when s (yield d)))

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

(let ((#:g159 (izip data selectors))) (loop do (if-generator ((d s) #:g159) (progn (when s (yield d))) (return))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:div (:div)))

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

Input: (with-html-string (:div (:div)))

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

(with-output-to-string (*html*) (with-html (:div (:div))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(*> #'comment +skip-junk+)

Problem: Macro call that should be transformed by *>

Input: (*> #'comment +skip-junk+)

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

(lambda (#:*>-offset221) (multiple-value-bind (#:*>-res222 #:*>-next223) (funcall (function comment) #:*>-offset221) (if (ok? #:*>-res222) (funcall +skip-junk+ #:*>-next223) (fail #:*>-next223))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(assoc-cdr :jwks--uri disc)

What needs to change: Macro call that should be transformed by assoc-cdr

Input: (assoc-cdr :jwks--uri disc)

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

(cdr (assoc :jwks--uri disc :test (function eql)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(%escape-string-form (format nil "~A" form))

Problem: Macro call that should be transformed by %escape-string-form

Input: (%escape-string-form (format nil "~A" form))

Output:
(defmacro %escape-string-form (val)
  (let ((val2 (gensym)))
    `(let ((,val2 ,val))
       (if (should-escape-p ,val2)
           `(escape-string ,,val2)
           ,val2))))

(let ((#:g123 (format nil "~A" form))) (if (should-escape-p #:g123) (sb-int:quasiquote (escape-string #S(sb-impl::comma :expr #:g123 :kind 0))) #:g123))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(dflet ((foo/lock () 13) (list () 42)) (is (eql 42 (list))) (is (eql 13 (foo/lock))))

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

Input: (dflet ((foo/lock () 13) (list () 42)) (is (eql 42 (list))) (is (eql 13 (foo/lock))))

Output:
(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))

(progf (quote (foo/lock list)) (list (lambda nil 13) (lambda nil 42)) (is (eql 42 (list))) (is (eql 13 (foo/lock))))


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

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

Input:
(while nil
  :key
  nil)

Output: (defmacro WHILE ...)

(loop while nil
      do (progn :key nil))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(-> :p () (mt:open-latch latch))

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

Input: (-> :p () (mt:open-latch latch))

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

(atomically :p nil (cl-muth:open-latch latch))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is = 0.0f0 (read-from-string "0.0"))

Issue: Macro call that should be transformed by is

Input: (is = 0.0f0 (read-from-string "0.0"))

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (is = 0.0 (read-from-string "0.0"))) :value-form (quote (read-from-string "0.0")) :body (lambda nil (read-from-string "0.0")) :expected 0.0 :comparison (quote =)))


Instruction:
Generate a defmacro form that transforms code like this:
(defclause (appending expr &optional into var at (place 'end)) "Append into a list" (return-collection-code :variable var :expression expr :start-operation 'append :end-operation '(subst (var expr) (copy-list expr)) :place place :one-element nil))

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

Input: (defclause (appending expr &optional into var at (place 'end)) "Append into a list" (return-collection-code :variable var :expression expr :start-operation 'append :end-operation '(subst (var expr) (copy-list expr)) :place place :one-element nil))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-appending-20 (&key ((:appending expr)) ((:into var)) ((:at place) (quote end))) "Append into a list" (return-collection-code :variable var :expression expr :start-operation (quote append) :end-operation (quote (subst (var expr) (copy-list expr))) :place place :one-element nil)) (install-clause-info (quote (appending)) (quote (appending &optional :into :at)) (quote clause-appending-20) "Append into a list" nil) (quote (appending expr &optional into var at (place (quote end)))))


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

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

Input:
(dynamic-relet nil
  (progn))

Output: (defmacro DYNAMIC-RELET ...)

(dynamic-wind
  :proceed
  #:proceed190
  (let ()
    (declare (special))
    (#:proceed190 (progn))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(~> (loop for i from 0 below 3 collecting (let ((i i)) (-> :p (a) (declare (type fixnum a)) (the fixnum (+ a i))))))

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

Input: (~> (loop for i from 0 below 3 collecting (let ((i i)) (-> :p (a) (declare (type fixnum a)) (the fixnum (+ a i))))))

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

(concurrently (loop for i from 0 below 3 collecting (let ((i i)) (-> :p (a) (declare (type fixnum a)) (the fixnum (+ a i))))))


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

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

Input: (as->* nil)

Output: (defmacro AS->* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(defsynonym maximizing :max)

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

Input: (defsynonym maximizing :max)

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

(eval-always (setf (get (quote maximizing) (quote synonym)) (quote :max)))


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

Problem: Macro call that should be transformed by ADVISABLE-LAMBDA

Input:
(advisable-lambda nil
  (progn))

Output: (defmacro ADVISABLE-LAMBDA ...)

(make-instance 'advisable-function :main #'(lambda () (progn)) :arguments 'nil
               :dispatcher-generator
               #'(lambda (#:fobj126)
                   #'(lambda ()
                       #A((29) base-char . "Advisable function dispatcher")
                       (let ((#:fixed127 (append)))
                         (apply-before #:fobj126 #:fixed127)
                         (multiple-value-prog1
                             (apply-around #:fobj126 #:fixed127)
                           (apply-after #:fobj126 #:fixed127))))))


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

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

Input:
(let+ nil
  (progn))

Output: (defmacro LET+ ...)


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

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

Input: (is (plusp 1))

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

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

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

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

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

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


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

Issue: Macro call that should be transformed by LET+

Input:
(let+ nil
  nil)

Output: (defmacro LET+ ...)


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

Problem: Macro call that should be transformed by F_

Output: (defmacro F_ ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-space (if safe? (write-string string *html*) (escape-to-stream string #'escape-string-char *html*)))

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

Input: (with-space (if safe? (write-string string *html*) (escape-to-stream string #'escape-string-char *html*)))

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

(flet ((#:stack-fn-body1 nil (if safe? (write-string string *html*) (escape-to-stream string (function escape-string-char) *html*)))) (declare (dynamic-extent (function #:stack-fn-body1))) (symbol-macrolet ((#:stack-fn-body1 (function #:stack-fn-body1))) (call-with-space #:stack-fn-body1)))


Instruction:
Generate a defmacro form that transforms code like this:
(defsynonym thereis :there-is)

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

Input: (defsynonym thereis :there-is)

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error assignment-type-match (:error-type varjo-critical-error) (code-obj-a code-obj-b form) "Currently varjo cannot handle changing the type through an assignment due to the static nature of glsl. place: ~a value: ~a Problematic form: ~s" (type->type-spec (primary-type code-obj-a)) (type->type-spec (primary-type code-obj-b)) form)

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

Input: (define-error assignment-type-match (:error-type varjo-critical-error) (code-obj-a code-obj-b form) "Currently varjo cannot handle changing the type through an assignment due to the static nature of glsl. place: ~a value: ~a Problematic form: ~s" (type->type-spec (primary-type code-obj-a)) (type->type-spec (primary-type code-obj-b)) form)

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

(defcondition assignment-type-match (:error-type varjo-critical-error :prefix "Varjo") (code-obj-a code-obj-b form) "Currently varjo cannot handle changing the type through an assignment due to the static nature of glsl. place: ~a value: ~a Problematic form: ~s" (type->type-spec (primary-type code-obj-a)) (type->type-spec (primary-type code-obj-b)) form)


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

Issue: Macro call that should be transformed by AND

Input: (and nil nil)

Output: (defmacro AND ...)


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

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

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

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(draw-relative (intern (concatenate 'string (string name) "-R")))

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

Input: (draw-relative (intern (concatenate 'string (string name) "-R")))

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

(draw-relative (intern (concatenate (quote string) (string name) "-R")))


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

Issue: Macro call that should be transformed by DEFRULE

Input: (defrule nil)

Output: (defmacro DEFRULE ...)

(setf (gethash #A((3) base-char . "NIL") cl-rules.core::*rules*)
        '#S(cl-rules.core::rule
            :name #A((3) base-char . "NIL")
            :conditions nil
            :actions nil))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-hook-type void (function ()) "Empty hook type with no arguments.")

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

Input: (define-hook-type void (function ()) "Empty hook type with no arguments.")

Output:
(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))))))

(defclass hook-void (hook) ((handler-type :initform (quote (function nil)) :allocation :class)) (:metaclass sb-mop:funcallable-standard-class) (:documentation "Empty hook type with no arguments."))


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

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

Input: (collect nil (progn))

Output: (defmacro COLLECT ...)

(common-lisp:let* ((#:generator-601 (generator (progn)))
                   #:items-594
                   #:seq-595
                   (#:limit-596
                    (common-lisp:multiple-value-bind (x y)
                        (decode-seq-type (list 'quote nil))
                      (declare (ignore x))
                      y))
                   (#:lst-597 nil))
  (declare (type generator #:generator-601)
           (type (null-or nonnegative-integer) #:limit-596)
           (type list #:lst-597))
  (tagbody
   #:ll-602
    (setq #:items-594 (next-in #:generator-601 (go end)))
    (setq #:lst-597 (cons #:items-594 #:lst-597))
    (go #:ll-602)
   end)
  (common-lisp:let ((num (length #:lst-597)))
    (declare (type nonnegative-integer num))
    (setq #:seq-595 (make-sequence nil (or #:limit-596 num)))
    (do ((i (1- num) (1- i)))
        ((minusp i))
      (setf (elt #:seq-595 i) (pop #:lst-597))))
  #:seq-595)


Instruction:
Generate a defmacro form that transforms code like this:
(define-script-symbol-macro 'some-name)

Pattern to recognize: Macro call that should be transformed by DEFINE-SCRIPT-SYMBOL-MACRO

Input: (define-script-symbol-macro 'some-name)

Output: (defmacro DEFINE-SCRIPT-SYMBOL-MACRO ...)


Instruction:
Generate a defmacro form that transforms code like this:
(signal-syntax-error "Backreference to register ~A which has not been defined." max-back-ref)

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

Input: (signal-syntax-error "Backreference to register ~A which has not been defined." max-back-ref)

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

(signal-syntax-error* nil "Backreference to register ~A which has not been defined." max-back-ref)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvar-unbound *readtable-copy* "Bound to the current readtable if it has to be temporarily modified.")

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

Input: (defvar-unbound *readtable-copy* "Bound to the current readtable if it has to be temporarily modified.")

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

(eval-when (:load-toplevel :compile-toplevel :execute) (defvar *readtable-copy*) (setf (documentation (quote *readtable-copy*) (quote variable)) "Bound to the current readtable if it has to be temporarily modified."))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(c?-with-stored (v :foo store 'nothing) (bwhen (val (value v)) (1+ val)))

Problem: Macro call that should be transformed by c?-with-stored

Input: (c?-with-stored (v :foo store 'nothing) (bwhen (val (value v)) (1+ val)))

Output:
(defmacro c?-with-stored ((var key store &optional default) &body body)
  `(c? (bwhen-c-stored (,var ,key ,store ,default)
	 ,@body)))

(c? (bwhen-c-stored (v :foo store (quote nothing)) (bwhen (val (value v)) (1+ val))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-cfun c-malloc)

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

Input: (define-cfun c-malloc)

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

(progn (defun c-malloc (size) (let ((#:size193 size)) (declare (ignorable #:size193)) (cffi-sys:%foreign-funcall "malloc" (:unsigned-long-long #:size193 :pointer) :convention :cdecl))))


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

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

Input: (defsynonym while :while)

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(mvlet* ((x y (floor 20 6)) (z a (values x 5))) (+ x y z a))

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

Input: (mvlet* ((x y (floor 20 6)) (z a (values x 5))) (+ x y z a))

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

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

    (var var*... expr)

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

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

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

(multiple-value-bind (x y) (floor 20 6) (mvlet* ((z a (values x 5))) (+ x y z a)))


Instruction:
Generate a defmacro form that transforms code like this:
(do-generators ((g (some-numbers)) (:list l data)) (yield (+ l g)))

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

Input: (do-generators ((g (some-numbers)) (:list l data)) (yield (+ l g)))

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

(let ((#:g172 (multi-gen (some-numbers) (list->generator data)))) (loop do (destructuring-bind (#:g174 . #:g173) (multiple-value-list (next-generator-value #:g172)) (unless #:g174 (return)) (let ((g (elt (elt #:g173 0) 0)) (l (elt (elt #:g173 1) 0))) (yield (+ l g))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-script-symbol-macro nil
  :key
  nil)

Pattern to recognize: Macro call that should be transformed by DEFINE-SCRIPT-SYMBOL-MACRO

Input:
(define-script-symbol-macro nil
  :key
  nil)

Output: (defmacro DEFINE-SCRIPT-SYMBOL-MACRO ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq)) (member target bound-variables :test #'eq)) (setf unsafe? t)) (values))

Issue: Macro call that should be transformed by action

Input: (action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq)) (member target bound-variables :test #'eq)) (setf unsafe? t)) (values))

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

(make-action (quote :after) (quote node-variable) (lambda (node bound-variables) (declare (type node-variable node)) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test (function eq))) (member target bound-variables :test (function eq))) (setf unsafe? t)) (values)))


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

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

Input: (some-> nil (progn))

Output: (defmacro SOME-> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(when export `(export '(,name ,@slot-list)))

Issue: Macro call that should be transformed by when

Input: (when export `(export '(,name ,@slot-list)))

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

(if export (sb-int:quasiquote (export (quote (#S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr slot-list :kind 2))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(lambda* nil
  :key
  nil)

Issue: Macro call that should be transformed by LAMBDA*

Input:
(lambda* nil
  :key
  nil)

Output: (defmacro LAMBDA* ...)

(lambda () (the t (block nil :key nil)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(do+ (for x (from 0)) (generating y (across #(0 1))) (collect (list x y)) (when (oddp x) (is (= (update y) y))))

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

Input: (do+ (for x (from 0)) (generating y (across #(0 1))) (collect (list x y)) (when (oddp x) (is (= (update y) y))))

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

(do+/internal nil (for x (from 0)) (generating y (across #(0 1))) (collect (list x y)) (when (oddp x) (is (= (update y) y))))


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

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

Input: (define-template nil nil)

Output: (defmacro DEFINE-TEMPLATE ...)

(defmacro define-nil (&optional (#:name126))
  (flet ((template-unfulfillable ()
           (error 'template-unfulfillable :template 'nil :arguments (list))))
    (declare (ignorable (function template-unfulfillable)))
    (let ((body (progn)) (name (or #:name126 (compose-name #\SOLIDUS 'nil))))
      `(progn
        (declaim
         (ftype
          (function
           ,(loop with types = (declared-variable-types body)
                  for arg in (quote nil)
                  collect (or (second (assoc arg types)) (quote t)))
           ,(declared-return-type body))
          ,name)
         ,@(when (find (quote inline) (declarations body)) `((inline ,name))))
        (defun ,name ,'nil
          (declare (optimize speed (safety 0) (debug 0) (compilation-speed 0))
                   ,@(remove (quote inline) (declarations body)))
          ,@(remove-if #'declaration-p body))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-mocks () (register-mock 'foo) (let ((sym (gensym))) (foo sym) (is (equal `((foo ,sym)) (invocations)))))

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

Input: (with-mocks () (register-mock 'foo) (let ((sym (gensym))) (foo sym) (is (equal `((foo ,sym)) (invocations)))))

Output:
(defmacro with-mocks ((&key (recordp T)) &body body)
  "Execute BODY in a new mocking context.  Invocations will be recorded
if RECORDP is set (default true)."
  `(call-with-mocks
    (lambda () ,@body)
    :recordp ,recordp))

(call-with-mocks (lambda nil (register-mock (quote foo)) (let ((sym (gensym))) (foo sym) (is (equal (sb-int:quasiquote ((foo #S(sb-impl::comma :expr sym :kind 0)))) (invocations))))) :recordp t)


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

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

Input: (lambda () (progn))

Output: (defmacro LAMBDA ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-error switch-type-error () (form) "Currently the clause forms of a switch must all be either ints, uints, floats or doubles:~%Code:~%~a" form)

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

Input: (define-error switch-type-error () (form) "Currently the clause forms of a switch must all be either ints, uints, floats or doubles:~%Code:~%~a" form)

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

(defcondition switch-type-error (:error-type varjo-error :prefix "Varjo") (form) "Currently the clause forms of a switch must all be either ints, uints, floats or doubles:~%Code:~%~a" form)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-cache ("foo" :store storage) (error "MUST NOT BE ERROR"))

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

Input: (with-cache ("foo" :store storage) (error "MUST NOT BE ERROR"))

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

Example:

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

(let ((#:key237 "foo") (#:store238 storage) (#:expire239 nil)) (multiple-value-bind (#:value240 #:exists-p241) (getcache #:key237 #:store238) (if #:exists-p241 #:value240 (let ((#:value240 (progn (error "MUST NOT BE ERROR")))) (setcache #:key237 #:value240 #:store238 :expire #:expire239) #:value240))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(action (:after node-bind node) (multiple-value-bind (new-node new-changed?) (maybe-collapse-bind node) (when new-changed? (setf changed? t) new-node)))

Issue: Macro call that should be transformed by action

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

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

(make-action (quote :after) (quote node-bind) (lambda (node) (declare (type node-bind node)) (multiple-value-bind (new-node new-changed?) (maybe-collapse-bind node) (when new-changed? (setf changed? t) new-node))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "~{~A~^, ~}" (mapcar (lambda (element) (if (sql-statement-p element) (format nil "(~A)" (yield element)) (yield element))) (sql-list-elements list))))

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

Input: (with-yield-binds (format nil "~{~A~^, ~}" (mapcar (lambda (element) (if (sql-statement-p element) (format nil "(~A)" (yield element)) (yield element))) (sql-list-elements list))))

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

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~{~A~^, ~}" (mapcar (lambda (element) (if (sql-statement-p element) (format nil "(~A)" (yield element)) (yield element))) (sql-list-elements list)))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(like "truth" "^true")

Problem: Macro call that should be transformed by like

Input: (like "truth" "^true")

Output:
(defmacro like (got regex &optional desc)
  (with-gensyms (duration result)
    (once-only (regex desc)
      `(with-catching-errors (:description ,desc :expected ,regex)
         (with-duration ((,duration ,result) ,got)
           (test ,result ,regex ,desc
                 :duration ,duration
                 :test-fn (lambda (x y) (not (null (ppcre:scan y x))))
                 :report-expected-label "be like"))))))

(let ((#:regex211 "^true") (#:desc212 nil)) (with-catching-errors (:description #:desc212 :expected #:regex211) (with-duration ((#:duration209 #:result210) "truth") (test #:result210 #:regex211 #:desc212 :duration #:duration209 :test-fn (lambda (x y) (not (null (cl-ppcre:scan y x)))) :report-expected-label "be like"))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause (until expr) "Exit loop if test is non-nil" (setq *loop-end-used?* t) (return-code :body `((if ,(walk-expr expr) (go ,*loop-end*)))))

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

Input: (defclause (until expr) "Exit loop if test is non-nil" (setq *loop-end-used?* t) (return-code :body `((if ,(walk-expr expr) (go ,*loop-end*)))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-until-15 (&key ((:until expr))) "Exit loop if test is non-nil" (setq *loop-end-used?* t) (return-code :body (sb-int:quasiquote ((if #S(sb-impl::comma :expr (walk-expr expr) :kind 0) (go #S(sb-impl::comma :expr *loop-end* :kind 0))))))) (install-clause-info (quote (until)) (quote (until)) (quote clause-until-15) "Exit loop if test is non-nil" nil) (quote (until expr)))


Instruction:
Generate a defmacro form that transforms code like this:
(receive (one two three four) (values 1 2 3) (list one two three four))

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

Input: (receive (one two three four) (values 1 2 3) (list one two three four))

Output:
(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)))))

(multiple-value-call (lambda (one two three four) (list one two three four)) (values 1 2 3))


Instruction:
Generate a defmacro form that transforms code like this:
(rem-plist-val! nil nil)

Pattern to recognize: Macro call that should be transformed by REM-PLIST-VAL!

Input: (rem-plist-val! nil nil)

Output:
(defmacro rem-plist-val! (id place &key (test '(default-test)) (key '(default-key)))
  `(setf ,place
    (rem-plist-val ,id ,place :test ,test :key ,key)))

(setf nil (rem-plist-val nil nil :test (default-test) :key (default-key)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(~> (-> :g (a) (+ 1 a)) (list nil) (-> :g (a) (+ a 2)) (>> (-> :g (b) (+ b 6)) (-> :g (b) (+ b 7))) (list (-> :g (a) (+ a 3)) (-> :g (a) (+ a 4)) (-> :g (a) (values (+ a 5) -1))))

Issue: Macro call that should be transformed by ~>

Input: (~> (-> :g (a) (+ 1 a)) (list nil) (-> :g (a) (+ a 2)) (>> (-> :g (b) (+ b 6)) (-> :g (b) (+ b 7))) (list (-> :g (a) (+ a 3)) (-> :g (a) (+ a 4)) (-> :g (a) (values (+ a 5) -1))))

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