Instruction:
Generate a defmacro form that transforms code like this:
(defstruct-compile-time function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*))

Pattern to recognize: Macro call that should be transformed by defstruct-compile-time

Input: (defstruct-compile-time function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*))

Output:
(defmacro defstruct-compile-time (options &body items)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defstruct ,options ,@items)))

(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-alias-binding update updating)

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

Input: (define-alias-binding update updating)

Output:
(defmacro define-alias-binding (name referenced-binding-name)
  `(progn (setf (binding ',name) ',referenced-binding-name)
          ',name))

(progn (setf (binding (quote update)) (quote updating)) (quote update))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(declare-deprecated-operators nil (progn))

What needs to change: Macro call that should be transformed by DECLARE-DEPRECATED-OPERATORS

Input: (declare-deprecated-operators nil (progn))

Output: (defmacro DECLARE-DEPRECATED-OPERATORS ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-compiler-macro nil
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name 'nil :source-file where-from
              :source-form form))
      (when where-from
        (pushnew where-from (gethash 'nil *deprecation-locations*) :test
                 #'equalp))
      form))
  (define-compiler-macro (progn)
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name '(progn) :source-file
              where-from :source-form form))
      (when where-from
        (pushnew where-from (gethash '(progn) *deprecation-locations*) :test
                 #'equalp))
      form))
  (values))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(loop-on-custom (key var value) customizations collect (list var value))

Problem: Macro call that should be transformed by loop-on-custom

Input: (loop-on-custom (key var value) customizations collect (list var value))

Output:
(defmacro loop-on-custom ((key var &optional value) &rest clauses)
  (if value
      (destructuring-bind (key-args . clauses) clauses
        `(loop for (,key ,value) on ,key-args by #'cddr
            for ,var = (custom-key-to-variable ,key)
            if ,var ,@clauses))
      `(loop for (,var . ,key) in *custom-vars*
            ,@clauses)))

(loop for (key value) on customizations by (function cddr) for var = (custom-key-to-variable key) if var collect (list var value))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error not-core-type-error () (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)

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

Input: (define-error not-core-type-error () (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)

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

(defcondition not-core-type-error (:error-type varjo-error :prefix "Varjo") (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)


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

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

Input: (send 'some-name)

Output: (defmacro SEND ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) `(,(make-wrapper :function (lambda (body) `(with-hash-table-iterator (,iterator ,hash-table) ,body))) ,(make-iteration :bindings (list test key value) :initializations `((setf (values ,test ,key ,value) (,iterator))) :steps `((setf (values ,test ,key ,value) (,iterator))) :postconditions `((not (null ,test)))))))

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

Input: (defclause hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) `(,(make-wrapper :function (lambda (body) `(with-hash-table-iterator (,iterator ,hash-table) ,body))) ,(make-iteration :bindings (list test key value) :initializations `((setf (values ,test ,key ,value) (,iterator))) :steps `((setf (values ,test ,key ,value) (,iterator))) :postconditions `((not (null ,test)))))))

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

(progn (defmacro hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) (sb-int:quasiquote (#S(sb-impl::comma :expr (make-wrapper :function (lambda (body) (sb-int:quasiquote (with-hash-table-iterator (#S(sb-impl::comma :expr iterator :kind 0) #S(sb-impl::comma :expr hash-table :kind 0)) #S(sb-impl::comma :expr body :kind 0))))) :kind 0) #S(sb-impl::comma :expr (make-iteration :bindings (list test key value) :initializations (sb-int:quasiquote ((setf (values #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)) (#S(sb-impl::comma :expr iterator :kind 0))))) :steps (sb-int:quasiquote ((setf (values #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)) (#S(sb-impl::comma :expr iterator :kind 0))))) :postconditions (sb-int:quasiquote ((not (null #S(sb-impl::comma :expr test :kind 0)))))) :kind 0))))) (pushnew (quote hash-entries-of) *clauses*))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is (= 3 c))

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

Input: (is (= 3 c))

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

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

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

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

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

(let ((#:e274 3) (#:a275 c)) (if (progn (= #:e274 #:a275)) (add-result (quote test-passed) :test-expr (quote (= 3 c))) (process-failure (quote (= 3 c)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote c) #:a275 (quote =) #:e274)))


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

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

Input:
(with-ps-gensyms nil
  (progn))

Output: (defmacro WITH-PS-GENSYMS ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-test fixture :fix (*read-default-float-format*) (is = 0.0f0 (read-from-string "0.0")) (setf *read-default-float-format* 'double-float) (is = 0.0d0 (read-from-string "0.0")))

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

Input: (define-test fixture :fix (*read-default-float-format*) (is = 0.0f0 (read-from-string "0.0")) (setf *read-default-float-format* 'double-float) (is = 0.0d0 (read-from-string "0.0")))

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

(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote fixture) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote fixture) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (is = 0.0 (read-from-string "0.0"))) (lambda nil (setf *read-default-float-format* (quote double-float))) (lambda nil (is = 0.0d0 (read-from-string "0.0")))) :parent (quote nil) (quote :fix) (quote (*read-default-float-format*)))) (quote fixture))


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

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

Input:
(f0
  nil)

Output: (defmacro F0 ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(augment init-code init)

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

Input: (augment init-code init)

Output:
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(finish (error "NOPE"))

Problem: Macro call that should be transformed by finish

Input: (finish (error "NOPE"))

Output:
(defmacro finish (form &optional description &rest format-args)
  `(eval-in-context
    *context*
    (make-instance 'finishing-result
                   :expression '(finish ,form)
                   :body (lambda () ,form)
                   ,@(when description
                       `(:description (format NIL ,description ,@format-args))))))

(eval-in-context *context* (make-instance (quote finishing-result) :expression (quote (finish (error "NOPE"))) :body (lambda nil (error "NOPE"))))


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

What needs to change: Macro call that should be transformed by ENABLE-QUASI-QUOTED-LIST-SYNTAX

Input: (enable-quasi-quoted-list-syntax)

Output: (defmacro ENABLE-QUASI-QUOTED-LIST-SYNTAX ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(alet 43 (slet it it))

Problem: Macro call that should be transformed by alet

Input: (alet 43 (slet it it))

Output:
(defmacro alet (form &body body)
  "Binds the FORM to IT (via LET) in the scope of the BODY."
  `(anaphoric ignore-first ,form (progn ,@body)))

(anaphoric ignore-first 43 (progn (slet it it)))


Instruction:
Generate a defmacro form that transforms code like this:
(*> +opt-fws+ #'ccontent)

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

Input: (*> +opt-fws+ #'ccontent)

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 (#:*>-offset143) (multiple-value-bind (#:*>-res144 #:*>-next145) (funcall +opt-fws+ #:*>-offset143) (if (ok? #:*>-res144) (funcall (function ccontent) #:*>-next145) (fail #:*>-next145))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(enable-version-syntax)

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

Input: (enable-version-syntax)

Output:
(defmacro enable-version-syntax ()
  "Enable version reader syntax."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (%enable-version-syntax)))

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when body `(make-block ,body))

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

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

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(skip "Not ready yet" (false T) (is = 5 6))

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

Input: (skip "Not ready yet" (false T) (is = 5 6))

Output:
(defmacro skip (desc &body tests)
  `(with-forced-status (:skipped ,@(if (listp desc) desc (list desc)))
     ,@tests))

(with-forced-status (:skipped "Not ready yet") (false t) (is = 5 6))


Instruction:
Define a macro that eliminates this repetitive pattern:
;; Manual gensym creation is boilerplate-heavy
(defmacro with-temp (var &body body)
  (let ((g (gensym)))
    `(let ((,g ,var))
       ,@body)))
;; Every macro needs this pattern - repetitive and error-prone

Issue: Repeated gensym boilerplate in macro definitions — want automatic gensym creation from naming convention

Input:
;; Manual gensym creation is boilerplate-heavy
(defmacro with-temp (var &body body)
  (let ((g (gensym)))
    `(let ((,g ,var))
       ,@body)))
;; Every macro needs this pattern - repetitive and error-prone

Output:
(defun g!-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 2)
       (string= (symbol-name s)
                "G!"
                :start1 0
                :end1 2)))

(defmacro defmacro/g! (name args &rest body)
  (let ((syms (remove-duplicates
               (remove-if-not #'g!-symbol-p
                              (flatten body)))))
    (multiple-value-bind (body declarations docstring)
        (parse-body body :documentation t)
      `(defmacro ,name ,args
         ,@(when docstring
             (list docstring))
         ,@declarations
         (let ,(mapcar
                (lambda (s)
                  `(,s (gensym ,(subseq
                                 (symbol-name s)
                                 2))))
                syms)
           ,@body)))))

;; Usage:
;; (defmacro/g! with-temp (g!var &body body)
;;   `(let ((,g!var ,g!var))
;;      ,@body))
;;
;; g!var is automatically gensym'd to #:VAR1234 at expansion time
;; No capture risk - gensym is uninterned


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defcategory :warning (or :warning :error))

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

Input: (defcategory :warning (or :warning :error))

Output:
(defmacro defcategory (category &optional expands-as set)
  `(defcategory-fn ',category ',expands-as ,set))

(defcategory-fn (quote :warning) (quote (or :warning :error)) nil)


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

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

Input: (matrix-ctypecase nil)

Output: (defmacro MATRIX-CTYPECASE ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(do-generator-value-list (vars (apply #'multi-gen generators)) (apply #'yield (mapcar #'car vars)))

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

Input: (do-generator-value-list (vars (apply #'multi-gen generators)) (apply #'yield (mapcar #'car vars)))

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 ((#:g157 (apply (function multi-gen) generators))) (loop do (if-generator (vars #:g157) (progn (apply (function yield) (mapcar (function car) vars))) (return))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (format nil "~A~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar #'yield (sql-composed-statement-children statement))))

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

Input: (with-yield-binds (format nil "~A~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar #'yield (sql-composed-statement-children statement))))

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~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar (function yield) (sql-composed-statement-children statement)))) (loop for bind in (reverse *bind-values*) append bind)))


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

Problem: Macro call that should be transformed by LAMBDA*

Input: (lambda* 'some-name)

Output: (defmacro LAMBDA* ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(-> :tag-1 () ", concurrent")

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

Input: (-> :tag-1 () ", concurrent")

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(single-line-mode-p flags)

Problem: Macro call that should be transformed by single-line-mode-p

Input: (single-line-mode-p flags)

Output:
(defmacro single-line-mode-p (flags)
  "Accessor macro to extract the third flag out of a three-element flag list."
  `(third ,flags))


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

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

Input:
(resolving
  nil
  nil)

Output: (defmacro RESOLVING ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(deferror "23503" foreign-key-violation integrity-violation)

Problem: Macro call that should be transformed by deferror

Input: (deferror "23503" foreign-key-violation integrity-violation)

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

(progn (define-condition foreign-key-violation (integrity-violation) nil) (setf (gethash "23503" *error-table*) (quote foreign-key-violation)))


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

Issue: Macro call that should be transformed by DO-ITERATOR

Input: (do-iterator 'some-name)

Output: (defmacro DO-ITERATOR ...)

(iterate-for-effects some-name (lambda (quote)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-mocks () (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq 'foo (foo))))

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

Input: (with-mocks () (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq 'foo (foo))))

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 (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq (quote foo) (foo)))) :recordp t)


Instruction:
Generate a defmacro form that transforms code like this:
(lret* ((y 1) (y 2)) (declare (ignorable y)) 3)

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

Input: (lret* ((y 1) (y 2)) (declare (ignorable y)) 3)

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

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

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

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

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

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

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

(lret-aux let* ((y 1) (y 2)) (declare (ignorable y)) 3)


Instruction:
Define a macro that eliminates this repetitive pattern:
(alist-bind (type size) form `((:array ,@(parse-type type (aval :tag type)) ,size)))

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

Input: (alist-bind (type size) form `((:array ,@(parse-type type (aval :tag type)) ,size)))

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

(let ((#:alist236 form)) (let ((type (aval :type #:alist236)) (size (aval :size #:alist236))) (sb-int:quasiquote ((:array #S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2) #S(sb-impl::comma :expr size :kind 0))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defgenerator icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i)))

Problem: Macro call that should be transformed by defgenerator

Input: (defgenerator icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i)))

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

(defun icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (with-yield (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(who-ps-html nil nil)

Problem: Macro call that should be transformed by WHO-PS-HTML

Input: (who-ps-html nil nil)

Output: (defmacro WHO-PS-HTML ...)


Instruction:
Generate a defmacro form that transforms code like this:
(do-generator (g generator) (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil))))))

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

Input: (do-generator (g generator) (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil))))))

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 ((#:g162 generator)) (loop do (if-generator ((g) #:g162) (progn (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil)))))) (return))))


Instruction:
Generate a defmacro form that transforms code like this:
(draw scene (:path :d (path (move-to 100 400) (line-to-r 50 -25) (arc-to-r 25 25 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 50 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 75 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 100 -30 0 1 50 -25) (line-to-r 50 -25) (vertical-to-r 50))) :fill "none" :stroke "blue" :stroke-width 5)

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

Input: (draw scene (:path :d (path (move-to 100 400) (line-to-r 50 -25) (arc-to-r 25 25 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 50 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 75 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 100 -30 0 1 50 -25) (line-to-r 50 -25) (vertical-to-r 50))) :fill "none" :stroke "blue" :stroke-width 5)

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


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

Issue: Macro call that should be transformed by FGATHERLET

Input:
(fgatherlet nil
  nil)

Output: (defmacro FGATHERLET ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(secase (car x) (:y (setf it :no)) (:x (setf it :yes)))

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

Input: (secase (car x) (:y (setf it :no)) (:x (setf it :yes)))

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

(symbolic ecase (car x) (:y (setf it :no)) (:x (setf it :yes)))


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

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

Input: (c? (klin self))

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

(make-c-dependent :code (quote ((klin self))) :value-state :unevaluated :rule (c-lambda (klin self)))


Instruction:
Generate a defmacro form that transforms code like this:
(declare-deprecated-operators nil :key nil)

Pattern to recognize: Macro call that should be transformed by DECLARE-DEPRECATED-OPERATORS

Input: (declare-deprecated-operators nil :key nil)

Output: (defmacro DECLARE-DEPRECATED-OPERATORS ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-compiler-macro nil
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name 'nil :source-file where-from
              :source-form form))
      (when where-from
        (pushnew where-from (gethash 'nil *deprecation-locations*) :test
                 #'equalp))
      form))
  (define-compiler-macro :key
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name ':key :source-file where-from
              :source-form form))
      (when where-from
        (pushnew where-from (gethash ':key *deprecation-locations*) :test
                 #'equalp))
      form))
  (define-compiler-macro nil
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name 'nil :source-file where-from
              :source-form form))
      (when where-from
        (pushnew where-from (gethash 'nil *deprecation-locations*) :test
                 #'equalp))
      form))
  (values))


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

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

Input:
(defaction nil
    :key
  nil)

Output: (defmacro DEFACTION ...)

(setf (gethash #A((3) base-char . "NIL") cl-rules.core::*actions*)
        (lambda :key nil))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
;; Regex matching with captures requires manual multiple-value-bind
(multiple-value-bind (matchp captures)
    (cl-ppcre:scan-to-strings "_(\\w+)@(\\w+)\\.com_" email)
  (if matchp
      (let ((user (aref captures 0))
            (domain (aref captures 1)))
        (format t "~a at ~a~%" user domain))
      :invalid))

;; Verbose: bind result, extract captures by index, branch - repetitive

Write a macro that addresses: Regex matching with named captures requires verbose destructuring — want $1, $2, ... anaphors bound to capture groups

Input:
;; Regex matching with captures requires manual multiple-value-bind
(multiple-value-bind (matchp captures)
    (cl-ppcre:scan-to-strings "_(\\w+)@(\\w+)\\.com_" email)
  (if matchp
      (let ((user (aref captures 0))
            (domain (aref captures 1)))
        (format t "~a at ~a~%" user domain))
      :invalid))

;; Verbose: bind result, extract captures by index, branch - repetitive

Output:
#+cl-ppcre
(defun dollar-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 1)
       (string= (symbol-name s)
                "$"
                :start1 0
                :end1 1)
       (ignore-errors (parse-integer (subseq (symbol-name s) 1)))))

(defmacro! if-match ((match-regex str) then &optional else)
  (let* ((dollars (remove-duplicates
                   (remove-if-not #'dollar-symbol-p
                                  (flatten then))))
         (top (or (car (sort (mapcar #'dollar-symbol-p dollars) #'>))
                  0)))
    `(multiple-value-bind (,g!matches ,g!captures) (,match-regex ,str)
       (declare (ignorable ,g!matches ,g!captures))
       (let ((,g!captures-len (length ,g!captures)))
         (declare (ignorable ,g!captures-len))
         (symbol-macrolet ,(mapcar #`(,(symb "$" a1)
                                       (if (< ,g!captures-len ,a1)
                                           (error "Too few matchs: ~a unbound." ,(mkstr "$" a1))
                                           (aref ,g!captures ,(1- a1))))
                                   (loop for i from 1 to top collect i))
           (if ,g!matches
               ,then
               ,else))))))

;; (if-match (#~m_(\\w+)@(\\w+)\\.com_ email)
;;   (format t "~a at ~a~%" $1 $2)
;;   :invalid)
;;
;; $1, $2 bound to capture groups via symbol-macrolet
;; Out-of-bounds $N signals a clear error at runtime
;; Nested if-match works - each has its own capture bindings


Instruction:
Generate a defmacro form that transforms code like this:
(deferror "08P01" protocol-violation)

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

Input: (deferror "08P01" protocol-violation)

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

(progn (define-condition protocol-violation (database-error) nil) (setf (gethash "08P01" *error-table*) (quote protocol-violation)))


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

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

Input: (collect-last 'some-name)

Output: (defmacro COLLECT-LAST ...)

(common-lisp:let* ((#:generator-533 (generator 'some-name))
                   #:items-527
                   (#:item-529 nil))
  (declare (type generator #:generator-533)
           (type (null-or t) #:item-529))
  (tagbody
   #:ll-534
    (setq #:items-527 (next-in #:generator-533 (go end)))
    (setq #:item-529 #:items-527)
    (go #:ll-534)
   end)
  #:item-529)


Instruction:
Generate a defmacro form that transforms code like this:
(define-generic generic (a b &key c) (declare (ignorable a b c)))

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

Input: (define-generic generic (a b &key c) (declare (ignorable a b c)))

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

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

Example:

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

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

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

(prog1 (defgeneric generic (a b &key c) (:method (a b &key c) (declare (ignorable a b c)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(lexpr-$send nil (progn))

Write a macro that addresses: Macro call that should be transformed by LEXPR-$SEND

Input: (lexpr-$send nil (progn))

Output: (defmacro LEXPR-$SEND ...)


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

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

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

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


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

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

Input: (set-bop nil :key nil)

Output: (defmacro SET-BOP ...)

(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn
   (save-binfix)
   (mapc
    (lambda (ops)
      (mapc
       (lambda (op1)
         (when (eq (car op1) 'nil)
           (setf (cadr op1) ':key)
           (unless nil (setf (cddr op1) '(nil)))))
       ops))
    *binfix*)
   (assign-properties)))


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

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

Input: (define-modf-rewrite caar (expr) `(car (car ,(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 caar) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (car (car #S(sb-impl::comma :expr (second expr) :kind 0)))))))


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

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

Input: (c?-with-stored (v :bar 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 :bar store (quote nothing)) (bwhen (val (value v)) (1- val))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-hamt set (:test test :hash hash :table table) (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance 'hash-set :test test :hash hash :table (reduce #'%remove xs :initial-value table))))

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

Input: (with-hamt set (:test test :hash hash :table table) (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance 'hash-set :test test :hash hash :table (reduce #'%remove xs :initial-value table))))

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

(with-accessors ((test hamt-test) (hash hamt-hash) (table hamt-table)) set (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance (quote hash-set) :test test :hash hash :table (reduce (function %remove) xs :initial-value table))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-generic generic ((a a) (b b) &key (c nil)) (+ a b))

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

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

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

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

Example:

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

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

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

(prog1 (defgeneric generic (a b &key c) (:method ((a a) (b b) &key (c nil)) (+ a b))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(fmap #'1+ (ok (in "") 1))

Problem: Macro call that should be transformed by fmap

Input: (fmap #'1+ (ok (in "") 1))

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

(multiple-value-bind (res next) (ok (in "") 1) (if (failure? res) (fail next) (values (funcall (function 1+) res) next)))


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

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

Input: (dict-of nil :key nil)

Output: (defmacro DICT-OF ...)

(let ((#:dict131 (make-hash-table :test 'equal)))
  (do-for (:key nil)
    (multiple-value-call
        (lambda (#:k132 #:v133) (setf (gethash #:k132 #:dict131) #:v133))
      nil))
  #:dict131)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-op (:not-in infix-list-op))

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

Input: (define-op (:not-in infix-list-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 (not-in-op (:include infix-list-op (name "NOT IN")) (:constructor make-not-in-op (left right))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defhandler catch (catch tag &rest body) `(list ',catch ,(e tag) ,@(e-list body)))

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

Input: (defhandler catch (catch tag &rest body) `(list ',catch ,(e tag) ,@(e-list body)))

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

(progn (defun hander-catch (catch tag &rest body) (sb-int:quasiquote (list (quote #S(sb-impl::comma :expr catch :kind 0)) #S(sb-impl::comma :expr (e tag) :kind 0) #S(sb-impl::comma :expr (e-list body) :kind 2)))) (setf (gethash (quote catch) *form-handler*) (quote hander-catch)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-mustache-character #\> (make-instance 'partial-tag :text arg-text))

Issue: Macro call that should be transformed by define

Input: (define-mustache-character #\> (make-instance 'partial-tag :text arg-text))

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

(set-mustache-character #\GREATER-THAN_SIGN (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (make-instance (quote partial-tag) :text arg-text)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defannotation annotation (options function-definition-form) (:arity 2) (let ((name (definition-form-symbol (progn-form-last function-definition-form)))) `(progn (set-annotation-options ',name ',options) ,function-definition-form)))

Issue: Macro call that should be transformed by defannotation

Input: (defannotation annotation (options function-definition-form) (:arity 2) (let ((name (definition-form-symbol (progn-form-last function-definition-form)))) `(progn (set-annotation-options ',name ',options) ,function-definition-form)))

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

(progn (set-annotation-options (quote annotation) (quote (:arity 2))) (defmacro annotation (options function-definition-form) (let ((name (definition-form-symbol (progn-form-last function-definition-form)))) (sb-int:quasiquote (progn (set-annotation-options (quote #S(sb-impl::comma :expr name :kind 0)) (quote #S(sb-impl::comma :expr options :kind 0))) #S(sb-impl::comma :expr function-definition-form :kind 0))))))


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

Pattern to recognize: Macro call that should be transformed by ENABLE-SHARP-NUMBER-SYNTAX

Input: (enable-sharp-number-syntax)

Output: (defmacro ENABLE-SHARP-NUMBER-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-sharp-number-syntax-in-readtable)
  (values))


Instruction:
Generate a defmacro form that transforms code like this:
(define-bug no-args-remove-in-unrep-inlining () (func args args-code) " Sorry that you have hit this bug, if you have time please copy this error, your stack trace and (if possible) the code that triggered this error and raise an issue at https://github.com/cbaggers/varjo/issues Thankyou, and our apologies. ---- When trying to compile the function ~a we knew we had to inline as a local function to to one of the arguments being of an unrepresentable type. However No arguments were identified for moving from the function to the surrounding let. func: ~a args: ~a args-code: ~a " (slot-value func 'name) func args args-code)

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

Input: (define-bug no-args-remove-in-unrep-inlining () (func args args-code) " Sorry that you have hit this bug, if you have time please copy this error, your stack trace and (if possible) the code that triggered this error and raise an issue at https://github.com/cbaggers/varjo/issues Thankyou, and our apologies. ---- When trying to compile the function ~a we knew we had to inline as a local function to to one of the arguments being of an unrepresentable type. However No arguments were identified for moving from the function to the surrounding let. func: ~a args: ~a args-code: ~a " (slot-value func 'name) func args args-code)

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

(defcondition no-args-remove-in-unrep-inlining (:error-type varjo-error :prefix "Varjo Bug") (func args args-code) " Sorry that you have hit this bug, if you have time please copy this error, your stack trace and (if possible) the code that triggered this error and raise an issue at https://github.com/cbaggers/varjo/issues Thankyou, and our apologies. ---- When trying to compile the function ~a we knew we had to inline as a local function to to one of the arguments being of an unrepresentable type. However No arguments were identified for moving from the function to the surrounding let. func: ~a args: ~a args-code: ~a " (slot-value func (quote name)) func args args-code)


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

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

Input: (do-combinations 'some-name)

Output: (defmacro DO-COMBINATIONS ...)


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

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

Input: (false NIL)

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defjs map3() (emit this.name (ps:create :count 1)))

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

Input: (defjs map3() (emit this.name (ps:create :count 1)))

Output:
(defmacro defjs (name args &body body)
  "Define client side javascript. Works like defun; body is in lisp, with parenscript
   additions, like return. So (defjs hello (x y) (return (+ x y))) defines an adder.
   macro creates a lisp function which sends the javascript function over to the mongo
   server to be evaluated. Result is processed and returned to the reader.
   This will execute 10 times on the server :
   (mapcar (lambda (x) (hello 10 x)) (list 1 2 3 4 5 6 7 8 9 10))"
  `(let* ((js-body (parenscript:ps (lambda ,args ,@body))))
     (setf (gethash ',name *js-definitions*) js-body)
     (defun ,name ,args
       (get-element "retval" (car (docs (db.eval js-body ,@args)))))))

(let* ((js-body (parenscript:ps (lambda nil (emit this.name (parenscript:create :count 1)))))) (setf (gethash (quote map3) *js-definitions*) js-body) (defun map3 nil (get-element "retval" (car (docs (db.eval js-body))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error stage-order-error () (stage-type) "stage of type ~s is not valid at this place in the pipeline, this is either out of order or a stage of this type already exists" stage-type)

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

Input: (define-error stage-order-error () (stage-type) "stage of type ~s is not valid at this place in the pipeline, this is either out of order or a stage of this type already exists" stage-type)

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 stage-order-error (:error-type varjo-error :prefix "Varjo") (stage-type) "stage of type ~s is not valid at this place in the pipeline, this is either out of order or a stage of this type already exists" stage-type)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(c-assert fm-parent)

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

Input: (c-assert fm-parent)

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

(unless *stop* (unless fm-parent (c-break "failed assertion: ~a" (quote fm-parent))))


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

Issue: Macro call that should be transformed by LETV

Input: (letv)

Output: (defmacro LETV ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-error symbol-unidentified (:error-type varjo-critical-error) (sym) "Symbol '~s' is unidentified. ~@[However the symbol is valid in these stages: ~{~%- ~a~}~]" sym (mapcar #'string-downcase (mapcar #'string (find-stages-that-have-var sym))))

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

Input: (define-error symbol-unidentified (:error-type varjo-critical-error) (sym) "Symbol '~s' is unidentified. ~@[However the symbol is valid in these stages: ~{~%- ~a~}~]" sym (mapcar #'string-downcase (mapcar #'string (find-stages-that-have-var sym))))

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 symbol-unidentified (:error-type varjo-critical-error :prefix "Varjo") (sym) "Symbol '~s' is unidentified. ~@[However the symbol is valid in these stages: ~{~%- ~a~}~]" sym (mapcar (function string-downcase) (mapcar (function string) (find-stages-that-have-var sym))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defannotation doc (docstring definition-form) (:arity 2) "Add DOCSTRING documentation for DEFINITION-FORM." (progn-form-replace-last (lambda (definition-form) (case (definition-form-type definition-form) ((defvar defparameter defconstant defun defmethod defmacro deftype define-compiler-macro) (destructuring-bind (def name arg . body) definition-form `(,def ,name ,arg ,docstring ,@body))) ((defstruct) (destructuring-bind (def name-and-options . slots) definition-form `(,def ,name-and-options ,docstring ,@slots))) ((defclass define-condition) (destructuring-bind (def name supers slots . opts) definition-form (pushnew `(:documentation ,docstring) opts :key #'car) `(,def ,name ,supers ,slots ,@opts))) ((defgeneric) (destructuring-bind (def name args . opts) definition-form (pushnew `(:documentation ,docstring) opts :key #'car) `(,def ,name ,args ,@opts))) (t (error "Documentation not supported: ~a" definition-form)))) definition-form))

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

Input: (defannotation doc (docstring definition-form) (:arity 2) "Add DOCSTRING documentation for DEFINITION-FORM." (progn-form-replace-last (lambda (definition-form) (case (definition-form-type definition-form) ((defvar defparameter defconstant defun defmethod defmacro deftype define-compiler-macro) (destructuring-bind (def name arg . body) definition-form `(,def ,name ,arg ,docstring ,@body))) ((defstruct) (destructuring-bind (def name-and-options . slots) definition-form `(,def ,name-and-options ,docstring ,@slots))) ((defclass define-condition) (destructuring-bind (def name supers slots . opts) definition-form (pushnew `(:documentation ,docstring) opts :key #'car) `(,def ,name ,supers ,slots ,@opts))) ((defgeneric) (destructuring-bind (def name args . opts) definition-form (pushnew `(:documentation ,docstring) opts :key #'car) `(,def ,name ,args ,@opts))) (t (error "Documentation not supported: ~a" definition-form)))) definition-form))

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

(progn (set-annotation-options (quote doc) (quote (:arity 2))) (defmacro doc (docstring definition-form) "Add DOCSTRING documentation for DEFINITION-FORM." (progn-form-replace-last (lambda (definition-form) (case (definition-form-type definition-form) ((defvar defparameter defconstant defun defmethod defmacro deftype define-compiler-macro) (destructuring-bind (def name arg . body) definition-form (sb-int:quasiquote (#S(sb-impl::comma :expr def :kind 0) #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr arg :kind 0) #S(sb-impl::comma :expr docstring :kind 0) #S(sb-impl::comma :expr body :kind 2))))) ((defstruct) (destructuring-bind (def name-and-options . slots) definition-form (sb-int:quasiquote (#S(sb-impl::comma :expr def :kind 0) #S(sb-impl::comma :expr name-and-options :kind 0) #S(sb-impl::comma :expr docstring :kind 0) #S(sb-impl::comma :expr slots :kind 2))))) ((defclass define-condition) (destructuring-bind (def name supers slots . opts) definition-form (pushnew (sb-int:quasiquote (:documentation #S(sb-impl::comma :expr docstring :kind 0))) opts :key (function car)) (sb-int:quasiquote (#S(sb-impl::comma :expr def :kind 0) #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr supers :kind 0) #S(sb-impl::comma :expr slots :kind 0) #S(sb-impl::comma :expr opts :kind 2))))) ((defgeneric) (destructuring-bind (def name args . opts) definition-form (pushnew (sb-int:quasiquote (:documentation #S(sb-impl::comma :expr docstring :kind 0))) opts :key (function car)) (sb-int:quasiquote (#S(sb-impl::comma :expr def :kind 0) #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr args :kind 0) #S(sb-impl::comma :expr opts :kind 2))))) (t (error "Documentation not supported: ~a" definition-form)))) definition-form)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(make-float-converters encode-float64 decode-float64 11 52 nil)

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

Input: (make-float-converters encode-float64 decode-float64 11 52 nil)

Output:
(defmacro make-float-converters (encoder-name
                                 decoder-name
                                 exponent-bits
                                 significand-bits
                                 support-nan-and-infinity-p)
  "Writes an encoder and decoder function for floating point
numbers with the given amount of exponent and significand
bits (plus an extra sign bit). If support-nan-and-infinity-p is
true, the decoders will also understand these special cases. NaN
is represented as :not-a-number, and the infinities as
:positive-infinity and :negative-infinity. Note that this means
that the in- or output of these functions is not just floating
point numbers anymore, but also keywords."
  (let* ((total-bits (+ 1 exponent-bits significand-bits))
         (exponent-offset (1- (expt 2 (1- exponent-bits)))) ; (A)
         (sign-part `(ldb (byte 1 ,(1- total-bits)) bits))
         (exponent-part `(ldb (byte ,exponent-bits ,significand-bits) bits))
         (significand-part `(ldb (byte ,significand-bits 0) bits))
         (nan support-nan-and-infinity-p)
         (max-exponent (1- (expt 2 exponent-bits)))) ; (B)
    `(progn
       (defun ,encoder-name (float)
         ,@(unless nan `((declare (type float float))))
         (multiple-value-bind (sign significand exponent)
             (cond ,@(when nan `(((eq float :not-a-number)
                                  (values 0 1 ,max-exponent))
                                 ((eq float :positive-infinity)
                                  (values 0 0 ,max-exponent))
                                 ((eq float :negative-infinity)
                                  (values 1 0 ,max-exponent))))
                   ((zerop float)
                    (values 0 0 0))
                   (t
                    (multiple-value-bind (significand exponent sign)
                        (decode-float float)
                      (let ((exponent (+ (1- exponent) ,exponent-offset))
                            (sign (if (= sign 1.0) 0 1)))
                        (unless (< exponent ,(expt 2 exponent-bits))
                          (error "Floating point overflow when encoding ~A."
                                 float))
                        (if (< exponent 0) ; (C)
                            (values sign (ash (round (* ,(expt 2 significand-bits)
                                                        significand))
                                              exponent)
                                    0)
                            (values sign (round (* ,(expt 2 significand-bits)
                                                   (1- (* significand 2))))
                                    exponent))))))
           (let ((bits 0))
             (declare (type (unsigned-byte ,total-bits) bits))
             (setf ,sign-part sign
                   ,exponent-part exponent
                   ,significand-part significand)
             bits)))

       (defun ,decoder-name (bits)
         (declare (type (unsigned-byte ,total-bits) bits))
         (let* ((sign ,sign-part)
                (exponent ,exponent-part)
                (significand ,significand-part))
           ,@(when nan `((when (= exponent ,max-exponent)
                           (return-from ,decoder-name
                             (cond ((not (zerop significand)) :not-a-number)
                                   ((zerop sign) :positive-infinity)
                                   (t :negative-infinity))))))
           (if (zerop exponent) ; (D)
               (setf exponent 1)
               (setf (ldb (byte 1 ,significand-bits) significand) 1))
           (unless (zerop sign)
             (setf significand (- significand)))
           (scale-float (float significand ,(if (> total-bits 32) 1.0d0 1.0))
                        (- exponent ,(+ exponent-offset significand-bits))))))))

(progn (defun encode-float64 (float) (declare (type float float)) (multiple-value-bind (sign significand exponent) (cond ((zerop float) (values 0 0 0)) (t (multiple-value-bind (significand exponent sign) (decode-float float) (let ((exponent (+ (1- exponent) 1023)) (sign (if (= sign 1.0) 0 1))) (unless (< exponent 2048) (error "Floating point overflow when encoding ~A." float)) (if (< exponent 0) (values sign (ash (round (* 4503599627370496 significand)) exponent) 0) (values sign (round (* 4503599627370496 (1- (* significand 2)))) exponent)))))) (let ((bits 0)) (declare (type (unsigned-byte 64) bits)) (setf (ldb (byte 1 63) bits) sign (ldb (byte 11 52) bits) exponent (ldb (byte 52 0) bits) significand) bits))) (defun decode-float64 (bits) (declare (type (unsigned-byte 64) bits)) (let* ((sign (ldb (byte 1 63) bits)) (exponent (ldb (byte 11 52) bits)) (significand (ldb (byte 52 0) bits))) (if (zerop exponent) (setf exponent 1) (setf (ldb (byte 1 52) significand) 1)) (unless (zerop sign) (setf significand (- significand))) (scale-float (float significand 1.0d0) (- exponent 1075)))))


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

Issue: Macro call that should be transformed by PSETF

Input: (psetf)

Output: (defmacro PSETF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(c?-with-stored (v :bar store 'nothing) (bwhen (val (value v)) val))

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

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

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

(c? (bwhen-c-stored (v :bar store (quote nothing)) (bwhen (val (value v)) val)))


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

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

Input:
(drelet nil
  (progn))

Output: (defmacro DRELET ...)


Instruction:
Generate a defmacro form that transforms code like this:
(defun/1 gets (str) (fgets-is-dumb str most-positive-fixnum stdin t))

Pattern to recognize: Macro call that should be transformed by defun/1

Input: (defun/1 gets (str) (fgets-is-dumb str most-positive-fixnum stdin t))

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 gets (str) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (fgets-is-dumb str most-positive-fixnum stdin t)) (defparameter gets (vacietis.c:mkptr& (symbol-function (quote gets)))))


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

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

Input:
(mvlet nil
  nil)

Output: (defmacro MVLET ...)


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

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

Input: (dynamic-relet* nil)

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


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

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

Input: (some-> nil :key nil)

Output: (defmacro SOME-> ...)


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

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

Input: (define-library libwinpthread)

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

(change-class (cffi::get-foreign-library (quote libwinpthread)) (quote library))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun-compile-time walk-function (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper FUNCTION: ~S" form)) (unless (= (length form) 2) (error "FUNCTION must have one argument: ~S" form)) (cond ((lambda-expression? (second form)) (if (and reduce-function nested?) (funcall reduce-function (funcall map-function form 'function-lambda) (funcall reduce-function (walk-lambda-list map-function reduce-function screamer? partial? nested? (second (second form)) environment) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (peal-off-documentation-string-and-declarations (rest (rest (second form))) t))))) (funcall map-function form 'function-lambda))) ((valid-function-name? (second form)) (cond ((symbolp (second form)) (if (or (special-operator-p (second form)) (macro-function (second form) environment)) (error "You can't reference the FUNCTION of a special form or~%~ macro: ~S" form) (funcall map-function form 'function-symbol))) (t (funcall map-function form 'function-setf)))) (t (error "Invalid argument to FUNCTION: ~S" form))))

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

Input: (defun-compile-time walk-function (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper FUNCTION: ~S" form)) (unless (= (length form) 2) (error "FUNCTION must have one argument: ~S" form)) (cond ((lambda-expression? (second form)) (if (and reduce-function nested?) (funcall reduce-function (funcall map-function form 'function-lambda) (funcall reduce-function (walk-lambda-list map-function reduce-function screamer? partial? nested? (second (second form)) environment) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (peal-off-documentation-string-and-declarations (rest (rest (second form))) t))))) (funcall map-function form 'function-lambda))) ((valid-function-name? (second form)) (cond ((symbolp (second form)) (if (or (special-operator-p (second form)) (macro-function (second form) environment)) (error "You can't reference the FUNCTION of a special form or~%~ macro: ~S" form) (funcall map-function form 'function-symbol))) (t (funcall map-function form 'function-setf)))) (t (error "Invalid argument to FUNCTION: ~S" form))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun walk-function (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper FUNCTION: ~S" form)) (unless (= (length form) 2) (error "FUNCTION must have one argument: ~S" form)) (cond ((lambda-expression? (second form)) (if (and reduce-function nested?) (funcall reduce-function (funcall map-function form (quote function-lambda)) (funcall reduce-function (walk-lambda-list map-function reduce-function screamer? partial? nested? (second (second form)) environment) (reduce reduce-function (mapcar (function (lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment))) (peal-off-documentation-string-and-declarations (rest (rest (second form))) t))))) (funcall map-function form (quote function-lambda)))) ((valid-function-name? (second form)) (cond ((symbolp (second form)) (if (or (special-operator-p (second form)) (macro-function (second form) environment)) (error "You can't reference the FUNCTION of a special form or~%~ macro: ~S" form) (funcall map-function form (quote function-symbol)))) (t (funcall map-function form (quote function-setf))))) (t (error "Invalid argument to FUNCTION: ~S" form)))) (eval-when (:compile-toplevel) (compile (quote walk-function))))


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

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

Input: (collect-max 'some-name)

Output: (defmacro COLLECT-MAX ...)

(common-lisp:let* ((#:generator-387 (generator 'some-name))
                   #:numbers-381
                   (#:number-383 nil))
  (declare (type generator #:generator-387))
  (tagbody
   #:ll-388
    (setq #:numbers-381 (next-in #:generator-387 (go end)))
    (if (or (null #:number-383) (< #:number-383 #:numbers-381))
        (setq #:number-383 #:numbers-381))
    (go #:ll-388)
   end)
  (if (null #:number-383)
      (setq #:number-383 nil))
  #:number-383)


Instruction:
Define a macro that eliminates this repetitive pattern:
(builder :session (lambda (env) (when (string= (getf env :path-info) "/expire") (setf (getf (getf env :lack.session.options) :expire) t)) '(200 () ("hi"))))

Issue: Macro call that should be transformed by builder

Input: (builder :session (lambda (env) (when (string= (getf env :path-info) "/expire") (setf (getf (getf env :lack.session.options) :expire) t)) '(200 () ("hi"))))

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

(reduce (function funcall) (remove-if (function null) (list (find-middleware :session))) :initial-value (to-app (lambda (env) (when (string= (getf env :path-info) "/expire") (setf (getf (getf env :lack.session.options) :expire) t)) (quote (200 nil ("hi"))))) :from-end t)


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

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

Input: ($op* op l)

Output:
(defmacro $op* (op &rest args)
  (let ((keys (gensym))
	(key  (gensym))
	(kvc  (gensym))
	(val  (gensym)))
    `(multiple-value-bind (,keys ,val) (op-split (unwrap (list ($exp+ ,@args))))
       (let ((,kvc (kv (car ,keys) (kv ,op ,val))))
	 (dolist (,key (cdr ,keys))
	   (setf ,kvc (kv ,kvc (kv ,key (kv ,op ,val)))))
	 ,kvc))))


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

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

Input: (some->> 'some-name)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-html (:doctype) (:html (:body (:div (:p lorem-ipsum (:span) (:a :href "" :data-instant t "Hello") lorem-ipsum)))))

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

Input: (with-html (:doctype) (:html (:body (:div (:p lorem-ipsum (:span) (:a :href "" :data-instant t "Hello") lorem-ipsum)))))

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

(let ((*html* (ensure-html-stream *html*))) (progn (doctype) (with-tag (:html :lang *html-lang*) (with-tag (:body) (with-tag (:div) (with-tag (:p) lorem-ipsum (with-tag (:span)) (with-tag (:a :href "" :data-instant t) "Hello") lorem-ipsum))))))


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

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

Input: (undefcategory :debug)

Output:
(defmacro undefcategory (category &optional set)
  `(undefcategory-fn ',category ,set))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?'." next-char)

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

Input: (signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?'." next-char)

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

(error (quote ppcre-syntax-error) :pos (1- (lexer-pos lexer)) :format-control "Character '~A' may not follow '(?'." :format-arguments (list next-char))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(-> :g () (put 0) 1)

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

Input: (-> :g () (put 0) 1)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(-> :p (a) (declare (type fixnum a)) (the fixnum (+ a i)))

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

Input: (-> :p (a) (declare (type fixnum a)) (the fixnum (+ a i)))

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

(atomically :p (a) (declare (type fixnum a)) (the fixnum (+ a i)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-interpreter oid:+char+ "char" int 1)

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

Input: (define-interpreter oid:+char+ "char" int 1)

Output:
(defmacro define-interpreter (oid name fields &body value)
  "Shorthand for defining binary readers."
  (declare (ignore name)) ;; Names are there just for clarity
  `(set-sql-reader ,oid (binary-reader ,fields ,@value) :binary-p t))

(set-sql-reader cl-postgres-oid:+char+ (binary-reader int 1) :binary-p t)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(aand 1 t (values it 2))

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

Input: (aand 1 t (values it 2))

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


Instruction:
Generate a defmacro form that transforms code like this:
(with-decoder-simple-list-semantics (is (equalp (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")) '((:bar . 46) (:xyzzy . t) (:quux . 98) (:prototype . ((:lisp-package . "jsonTest") (:lisp-class . "frob")))))))

Pattern to recognize: Macro call that should be transformed by with-decoder-simple-list-semantics

Input: (with-decoder-simple-list-semantics (is (equalp (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")) '((:bar . 46) (:xyzzy . t) (:quux . 98) (:prototype . ((:lisp-package . "jsonTest") (:lisp-class . "frob")))))))

Output:
(defmacro with-decoder-simple-list-semantics (&body body)
  "Execute BODY in a dynamic environement where the decoder semantics
is such as set by SET-DECODER-SIMPLE-LIST-SEMANTICS."
  `(with-shadowed-custom-vars
     (set-decoder-simple-list-semantics)
     ,@body))

(with-shadowed-custom-vars (set-decoder-simple-list-semantics) (is (equalp (decode-json-from-string (format nil input "{\"lispPackage\":\"jsonTest\", \"lispClass\":\"frob\"}")) (quote ((:bar . 46) (:xyzzy . t) (:quux . 98) (:prototype (:lisp-package . "jsonTest") (:lisp-class . "frob")))))))


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

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

Input:
(f_n
  nil
  nil)

Output: (defmacro F_N ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-forced-status (:failed) (false NIL))

Problem: Macro call that should be transformed by with-forced-status

Input: (with-forced-status (:failed) (false NIL))

Output:
(defmacro with-forced-status ((status &optional description &rest format-args) &body tests)
  `(eval-in-context
    *context*
    (make-instance 'controlling-result
                   :expression ,status
                   :child-status ,status
                   :body (lambda () ,@tests)
                   ,@(when description
                       `(:description (format NIL ,description ,@format-args))))))

(eval-in-context *context* (make-instance (quote controlling-result) :expression :failed :child-status :failed :body (lambda nil (false nil))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-wcs-math-error-handling ((quot rem) (fround x y)) (check-wcs-math-result) rem)

Pattern to recognize: Macro call that should be transformed by with-wcs-math-error-handling

Input: (with-wcs-math-error-handling ((quot rem) (fround x y)) (check-wcs-math-result) rem)

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

(let* ((#:g257 x) (#:g258 y) (#:g259 (list #:g257 #:g258))) (declare (ignorable #:g258) (type list #:g259) (dynamic-extent #:g259)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (quot rem) (call-with-wcs-math-error-handler (quote fround) #:g259) (flet ((check-wcs-math-result (&optional (ret quot) (arg-list #:g259)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result) rem))))


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

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

Input: (lambda () :key nil)

Output: (defmacro LAMBDA ...)


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

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

Input: (gathering nil)

Output: (defmacro GATHERING ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-preprocessor-state-slots (state) (when if-section-skip-reason (begin-if-section state '(:skipped :if) nil) (return-from process-preprocessing-directive nil)) (unless (preprocessor-token-exists-p directive-token-list) (raise-no-preprocessor-token-error directive-symbol)) (let ((result (eval-if-expression directive-symbol directive-token-list state))) (begin-if-section state directive-token-list result)))

Problem: Macro call that should be transformed by with-preprocessor-state-slots

Input: (with-preprocessor-state-slots (state) (when if-section-skip-reason (begin-if-section state '(:skipped :if) nil) (return-from process-preprocessing-directive nil)) (unless (preprocessor-token-exists-p directive-token-list) (raise-no-preprocessor-token-error directive-symbol)) (let ((result (eval-if-expression directive-symbol directive-token-list state))) (begin-if-section state directive-token-list result)))

Output:
(defmacro with-preprocessor-state-slots ((state) &body body)
  `(with-accessors ((file-pathname pp-state-file-pathname)
                    (token-list pp-state-token-list)
                    (result-list pp-state-result-list)
                    (line-number pp-state-line-number)
                    (tokens-in-line pp-state-tokens-in-line)
                    (macro-alist pp-state-macro-alist)
                    (if-section-stack pp-state-if-section-stack)
                    (if-section-skip-reason pp-state-if-section-skip-reason)
                    (include-stack pp-state-include-stack))
       ,state
     ,@body))

(with-accessors ((file-pathname pp-state-file-pathname) (token-list pp-state-token-list) (result-list pp-state-result-list) (line-number pp-state-line-number) (tokens-in-line pp-state-tokens-in-line) (macro-alist pp-state-macro-alist) (if-section-stack pp-state-if-section-stack) (if-section-skip-reason pp-state-if-section-skip-reason) (include-stack pp-state-include-stack)) state (when if-section-skip-reason (begin-if-section state (quote (:skipped :if)) nil) (return-from process-preprocessing-directive nil)) (unless (preprocessor-token-exists-p directive-token-list) (raise-no-preprocessor-token-error directive-symbol)) (let ((result (eval-if-expression directive-symbol directive-token-list state))) (begin-if-section state directive-token-list result)))