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

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

Input: (is (not (< 0 1)))

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

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

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

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

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

(let ((#:e198 0) (#:a199 1)) (if (progn (not (< #:e198 #:a199))) (add-result (quote test-passed) :test-expr (quote (not (< 0 1)))) (process-failure (quote (not (< 0 1))) "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)" (quote 1) #:a199 (quote <) #:e198)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-reader-syntax (string) (is (string-equal "5.0d0" (er "(let ((a 5.0d0)) $a)"))))

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

Input: (with-reader-syntax (string) (is (string-equal "5.0d0" (er "(let ((a 5.0d0)) $a)"))))

Output:
(defmacro with-reader-syntax (reader-macro-identifiers &body body)
  "This macro is only made for use by read-and-eval functionality,
and rather directed towards tests than users. So, do not export."
  (let ((identifiers (loop :for identifier :in reader-macro-identifiers
                           :collect `(quote ,identifier))))
    `(let ((*array-function*         'make-t-array-from-initial-contents)
           (*hash-table-function*    'alexandria:plist-hash-table)
           (*get-val-function*       'get-val)
           (*get-val-array-function* 'cl:aref)
           (*set-function*           'cl:remove-duplicates)
           (*alists-are-lists*       nil)
           (*plists-are-lists*       nil)
           (*readtable*             (%enable-reader-syntax *readtable* ,@identifiers)))
       ,@body)))

(let ((*array-function* (quote make-t-array-from-initial-contents)) (*hash-table-function* (quote alexandria:plist-hash-table)) (*get-val-function* (quote get-val)) (*get-val-array-function* (quote aref)) (*set-function* (quote remove-duplicates)) (*alists-are-lists* nil) (*plists-are-lists* nil) (*readtable* (%enable-reader-syntax *readtable* (quote string)))) (is (string-equal "5.0d0" (er "(let ((a 5.0d0)) $a)"))))


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

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

Input: (lret () 1)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-mocks () (answer (foo 1) 42) (answer foo 23) (is (eql 42 (foo 1))))

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

Input: (with-mocks () (answer (foo 1) 42) (answer foo 23) (is (eql 42 (foo 1))))

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 1) 42) (answer foo 23) (is (eql 42 (foo 1)))) :recordp t)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(unwind-protect-case (aborted-p) (protected-form) (:always (perform-cleanup-if aborted-p)))

Write a macro that addresses: Macro call that should be transformed by unwind-protect-case

Input: (unwind-protect-case (aborted-p) (protected-form) (:always (perform-cleanup-if aborted-p)))

Output:
(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
the cleanup CLAUSES are run.

  clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*

Clauses can be given in any order, and more than one clause can be
given for each circumstance. The clauses whose denoted circumstance
occured, are executed in the order the clauses appear.

ABORT-FLAG is the name of a variable that will be bound to T in
CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
otherwise.

Examples:

  (unwind-protect-case ()
       (protected-form)
     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
     (:always (format t \"This is evaluated in either case.~%\")))

  (unwind-protect-case (aborted-p)
       (protected-form)
     (:always (perform-cleanup-if aborted-p)))
"
  (check-type abort-flag (or null symbol))
  (let ((gflag (gensym "FLAG+")))
    `(let ((,gflag t))
       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
	 (let ,(and abort-flag `((,abort-flag ,gflag)))
	   ,@(loop for (cleanup-kind . forms) in clauses
		   collect (ecase cleanup-kind
			     (:normal `(when (not ,gflag) ,@forms))
			     (:abort  `(when ,gflag ,@forms))
			     (:always `(progn ,@forms)))))))))

(let ((#:flag+122 t)) (unwind-protect (multiple-value-prog1 (protected-form) (setf #:flag+122 nil)) (let ((aborted-p #:flag+122)) (progn (perform-cleanup-if aborted-p)))))


Instruction:
Generate a defmacro form that transforms code like this:
(def-neo4j-fun cypher-query (statements) :post (:uri-spec "transaction/commit") (:encode statements :statements) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

Pattern to recognize: Macro call that should be transformed by def-neo4j-fun

Input: (def-neo4j-fun cypher-query (statements) :post (:uri-spec "transaction/commit") (:encode statements :statements) (:status-handlers (200 (decode-neo4j-json-output body)) (404 (error 'node-not-found-error :uri uri))))

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

(progn (defun cypher-query (&key statements) (let ((uri "transaction/commit") (json (encode-neo4j-json-payload statements :statements))) (make-neo4j-request :post uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


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

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

Input: (-> nil nil)

Output: (defmacro -> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defannotation notinline* (name) (:alias notinline :inline t) "Shorthand for (DECLARE (NOTINLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type '(defun defmethod))) `(progn (declaim (notinline ,symbol)) ,name) `(declare (notinline ,name)))))

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

Input: (defannotation notinline* (name) (:alias notinline :inline t) "Shorthand for (DECLARE (NOTINLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type '(defun defmethod))) `(progn (declaim (notinline ,symbol)) ,name) `(declare (notinline ,name)))))

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 notinline*) (quote (:alias notinline :inline t))) (defmacro notinline* (name) "Shorthand for (DECLARE (NOTINLINE ...))." (let ((symbol (definition-form-symbol name)) (type (definition-form-type name))) (if (and symbol (member type (quote (defun defmethod)))) (sb-int:quasiquote (progn (declaim (notinline #S(sb-impl::comma :expr symbol :kind 0))) #S(sb-impl::comma :expr name :kind 0))) (sb-int:quasiquote (declare (notinline #S(sb-impl::comma :expr name :kind 0))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> +consume-ws-crlf+ +skipws1+)

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

Input: (*> +consume-ws-crlf+ +skipws1+)

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 (#:*>-offset131) (multiple-value-bind (#:*>-res132 #:*>-next133) (funcall +consume-ws-crlf+ #:*>-offset131) (if (ok? #:*>-res132) (funcall +skipws1+ #:*>-next133) (fail #:*>-next133))))


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

Problem: Macro call that should be transformed by DLETF

Input:
(dletf nil
  nil)

Output: (defmacro DLETF ...)

(special-symbol-progv (with-symbol-access
                        (list))
    (list)
  (locally (declare (special)) nil))


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

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

Input:
(some->
  nil
  nil)

Output: (defmacro SOME-> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ematch0 or1 ((list* 'or1 or-subpatterns) (list* 'or1 (mapcar (lambda (or-sp) `(and ,or-sp ,@guard1-patterns)) or-subpatterns))))

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

Input: (ematch0 or1 ((list* 'or1 or-subpatterns) (list* 'or1 (mapcar (lambda (or-sp) `(and ,or-sp ,@guard1-patterns)) or-subpatterns))))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 or1 ((list* (quote or1) or-subpatterns) (list* (quote or1) (mapcar (lambda (or-sp) (sb-int:quasiquote (and #S(sb-impl::comma :expr or-sp :kind 0) #S(sb-impl::comma :expr guard1-patterns :kind 2)))) or-subpatterns))) (_ (error "level0 match error!")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclass/std computer (gadget) ((screen mouse keyboard :a :type string :with) (bluetooth touchpad :wi :std :unbound) (speaker microphone :r) (place :@@ :with-prefix :doc "Where it is" :r) (owner :static :std "Me" :w)))

Write a macro that addresses: Macro call that should be transformed by defclass/std

Input: (defclass/std computer (gadget) ((screen mouse keyboard :a :type string :with) (bluetooth touchpad :wi :std :unbound) (speaker microphone :r) (place :@@ :with-prefix :doc "Where it is" :r) (owner :static :std "Me" :w)))

Output:
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

(defclass computer (gadget) ((screen :accessor computer-screen :type string) (mouse :accessor computer-mouse :type string) (keyboard :accessor computer-keyboard :type string) (bluetooth :writer bluetooth :initarg :bluetooth) (touchpad :writer touchpad :initarg :touchpad) (speaker :reader speaker :initform nil) (microphone :reader microphone :initform nil) (place :reader computer-place :initform nil :allocation :class :documentation "Where it is") (owner :writer owner :initform "Me" :allocation :class)))


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

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

Input:
(defpattern nil
    (progn))

Output: (defmacro DEFPATTERN ...)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(fail 'happy)

Problem: Macro call that should be transformed by fail

Input: (fail 'happy)

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
($map-reduce "foo" m r :out "testit" :query ($> "l" -900))

Write a macro that addresses: Macro call that should be transformed by $map-reduce

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

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(compile-time-report-wrap-failures)

Issue: Macro call that should be transformed by compile-time-report-wrap-failures

Input: (compile-time-report-wrap-failures)

Output:
(defmacro compile-time-report-wrap-failures ()
  (report-wrap-failures 'compile-time *error-output*))


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

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

Input:
(define-declaration nil
    nil)

Output: (defmacro DEFINE-DECLARATION ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (proclaim '(declaration nil))
  (flet ((sb-cltl2::func ()
           ))
    (setf (sb-int:info :declaration :known 'nil)
            (lambda
                (sb-kernel:lexenv sb-cltl2::spec sb-cltl2::pd-vars
                 sb-cltl2::pd-fvars)
              (multiple-value-bind (sb-cltl2::kind sb-cltl2::data)
                  (sb-cltl2::func sb-cltl2::spec sb-kernel:lexenv)
                (sb-cltl2::update-lexenv-user-data sb-kernel:lexenv
                                                   sb-cltl2::kind
                                                   sb-cltl2::data
                                                   sb-cltl2::pd-vars
                                                   sb-cltl2::pd-fvars))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
;; Anonymous recursion requires explicit labels every time
(labels ((self (n)
           (if (> n 0)
             (cons n (self (- n 1)))
             nil)))
  #'self)

;; labels boilerplate obscures the recursive logic

Write a macro that addresses: Need anonymous recursion without writing labels boilerplate — want implicit 'self' for recursion

Input:
;; Anonymous recursion requires explicit labels every time
(labels ((self (n)
           (if (> n 0)
             (cons n (self (- n 1)))
             nil)))
  #'self)

;; labels boilerplate obscures the recursive logic

Output:
(defmacro alambda (parms &body body)
  `(labels ((self ,parms ,@body))
     #'self))

;; (alambda (n)
;;   (if (> n 0)
;;     (cons n (self (- n 1)))
;;     nil))
;; Expands to:
;; (LABELS ((SELF (N)
;;            (IF (> N 0)
;;              (CONS N (SELF (- N 1)))
;;              NIL)))
;;   #'SELF)


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

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

Input: (setf nil nil)

Output: (defmacro SETF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(-> :g (a) (+ a 3))

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

Input: (-> :g (a) (+ a 3))

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defclause maximizing (form &key (test ''>) saving in) "Synonym for optimizing." `(optimizing ,form :test ,test :saving ,saving :in ,in))

Problem: Macro call that should be transformed by defclause

Input: (defclause maximizing (form &key (test ''>) saving in) "Synonym for optimizing." `(optimizing ,form :test ,test :saving ,saving :in ,in))

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 maximizing (form &key (test (quote (quote >))) saving in) "Synonym for optimizing." (sb-int:quasiquote (optimizing #S(sb-impl::comma :expr form :kind 0) :test #S(sb-impl::comma :expr test :kind 0) :saving #S(sb-impl::comma :expr saving :kind 0) :in #S(sb-impl::comma :expr in :kind 0)))) (pushnew (quote maximizing) *clauses*))


Instruction:
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error "Unknown token ~A in parse-tree." token)

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

Input: (signal-syntax-error "Unknown token ~A in parse-tree." token)

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

(signal-syntax-error* nil "Unknown token ~A in parse-tree." token)


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

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

Input: (some-> nil nil)

Output: (defmacro SOME-> ...)


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

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

Input:
(drelet nil
  :key
  nil)

Output: (defmacro DRELET ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(without-symbol-access
  nil)

Issue: Macro call that should be transformed by WITHOUT-SYMBOL-ACCESS

Input:
(without-symbol-access
  nil)

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


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

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

Input: (cardinality-case 'some-name)

Output: (defmacro CARDINALITY-CASE ...)

(let ((#:cardinality131 'some-name))
  (typecase #:cardinality131))


Instruction:
Define a macro that eliminates this repetitive pattern:
(do-generator-value-list (vars (apply #'multi-gen (loop for g in gens collect (list g :fill-value fillspec)))) (apply #'yield (mapcar #'car vars)))

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

Input: (do-generator-value-list (vars (apply #'multi-gen (loop for g in gens collect (list g :fill-value fillspec)))) (apply #'yield (mapcar #'car vars)))

Output:
(defmacro do-generator-value-list ((var generator) &body body)
  "Like do-generator, except all values emitted by the generator are placed in a list under the user defined variable."
  (let ((g (gensym)))
    `(let ((,g ,generator))
       (loop
	  do (if-generator (,var ,g)
			   (progn ,@body)
			   (return))))))

(let ((#:g180 (apply (function multi-gen) (loop for g in gens collect (list g :fill-value fillspec))))) (loop do (if-generator (vars #:g180) (progn (apply (function yield) (mapcar (function car) vars))) (return))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(make-obsolete mustache-render render "0.10.0")

Problem: Macro call that should be transformed by make-obsolete

Input: (make-obsolete mustache-render render "0.10.0")

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

(defun mustache-render (&rest args) "Render TEMPLATE with optional CONTEXT to *OUTPUT-STREAM* or OUTPUT-STREAM" (warn (quote deprecation-warning) :name (quote mustache-render) :replacement (quote render) :since "0.10.0") (apply (quote render) args))


Instruction:
Define a macro that eliminates this repetitive pattern:
(assert-values ("baz w/o lookup") (baz 'no-lookup))

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

Input: (assert-values ("baz w/o lookup") (baz 'no-lookup))

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

(progn (trc "baz w/o lookup") (assert (eql (value baz) (quote no-lookup))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(fail-compile (defun foo () (frob)) style-warning)

Issue: Macro call that should be transformed by fail-compile

Input: (fail-compile (defun foo () (frob)) style-warning)

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (fail-expansion (defun foo nil (frob)))) :value-form (quote (nth-value 3 (try-compile (quote (defun foo nil (frob))) (quote style-warning)))) :body (lambda nil (nth-value 3 (try-compile (quote (defun foo nil (frob))) (quote style-warning)))) :expected (quote style-warning) :comparison (quote typep)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defun/1 fwrite (mem element_size count fd) (handler-case (let ((start (memptr-ptr mem))) (write-sequence (memptr-mem mem) (fd-stream fd) :start start :end (+ start (* element_size count))) count) (error () (setf (ferror fd) EIO) 0)))

Write a macro that addresses: Macro call that should be transformed by defun/1

Input: (defun/1 fwrite (mem element_size count fd) (handler-case (let ((start (memptr-ptr mem))) (write-sequence (memptr-mem mem) (fd-stream fd) :start start :end (+ start (* element_size count))) count) (error () (setf (ferror fd) EIO) 0)))

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 fwrite (mem element_size count fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (handler-case (let ((start (memptr-ptr mem))) (write-sequence (memptr-mem mem) (fd-stream fd) :start start :end (+ start (* element_size count))) count) (error nil (setf (ferror fd) eio) 0))) (defparameter fwrite (vacietis.c:mkptr& (symbol-function (quote fwrite)))))


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

Problem: Macro call that should be transformed by DRELET

Input:
(drelet nil
  nil)

Output: (defmacro DRELET ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-alias-binding repeat repeating)

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

Input: (define-alias-binding repeat repeating)

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

(progn (setf (binding (quote repeat)) (quote repeating)) (quote repeat))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-yield (iterate (for (x) in-generator (some-numbers)) (yield (1+ x))))

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

Input: (with-yield (iterate (for (x) in-generator (some-numbers)) (yield (1+ x))))

Output:
(defmacro with-yield (&body body)
  (let ((point (gensym))
        (current (gensym)))
    `(let (,point ,current)
       (with-call/cc
	 (labels ((yield (&rest values)
		    (setf ,current values)
		    (let/cc k
		      (setf ,point k))))
	   ,@body
	   (setf ,point nil)))
       (gen-lambda ()
	 (cond ((null ,point)
		'generator-stop)
	       (t
		(let ((current ,current))
		  (funcall ,point nil)
		  ;values-handler: see gen-lambda
		  (apply #'values (funcall values-handler current)))))))))

(let (#:g151 #:g152) (with-call/cc (labels ((yield (&rest values) (setf #:g152 values) (let/cc k (setf #:g151 k)))) (iterate (for (x) in-generator (some-numbers)) (yield (1+ x))) (setf #:g151 nil))) (gen-lambda nil (cond ((null #:g151) (quote generator-stop)) (t (let ((current #:g152)) (funcall #:g151 nil) (apply (function values) (funcall values-handler current)))))))


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

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

Input: (pass)

Output:
(defmacro pass (&rest message-args)
  "Simply generate a PASS."
  `(add-result 'test-passed
               :test-expr ',message-args
               ,@(when message-args
                   `(:reason (format nil ,@message-args)))))

(add-result (quote test-passed) :test-expr (quote nil))


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

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

Input:
(auto-permute-typecase nil
  nil)

Output: (defmacro AUTO-PERMUTE-TYPECASE ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> (take 3) (take 2))

Issue: Macro call that should be transformed by *>

Input: (*> (take 3) (take 2))

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 (#:*>-offset209) (multiple-value-bind (#:*>-res210 #:*>-next211) (funcall (take 3) #:*>-offset209) (if (ok? #:*>-res210) (funcall (take 2) #:*>-next211) (fail #:*>-next211))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(atypecase 1.0 (integer (+ 2 it)) (float (1- it)))

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

Input: (atypecase 1.0 (integer (+ 2 it)) (float (1- it)))

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

(anaphoric typecase 1.0 (integer (+ 2 it)) (float (1- it)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (multiple-value-bind (header-name header-type) (parse-header-name directive-token-list directive-symbol t macro-alist state) (let* ((pathname (ecase header-type (:q-char-sequence (find-include-header-file header-name)) (:h-char-sequence (find-include-<header>-file header-name)))) (included-tokens (tokenize-included-source-file pathname state))) (push-include-state state) (pop-next-newline token-list) (setf token-list (nconc included-tokens token-list)))))

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

Input: (with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (multiple-value-bind (header-name header-type) (parse-header-name directive-token-list directive-symbol t macro-alist state) (let* ((pathname (ecase header-type (:q-char-sequence (find-include-header-file header-name)) (:h-char-sequence (find-include-<header>-file header-name)))) (included-tokens (tokenize-included-source-file pathname state))) (push-include-state state) (pop-next-newline token-list) (setf token-list (nconc included-tokens token-list)))))

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 (return-from process-preprocessing-directive nil)) (multiple-value-bind (header-name header-type) (parse-header-name directive-token-list directive-symbol t macro-alist state) (let* ((pathname (ecase header-type (:q-char-sequence (find-include-header-file header-name)) (:h-char-sequence (find-include-<header>-file header-name)))) (included-tokens (tokenize-included-source-file pathname state))) (push-include-state state) (pop-next-newline token-list) (setf token-list (nconc included-tokens token-list)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclass/a dbd-postgres (dbi-driver) ())

What needs to change: Macro call that should be transformed by defclass/a

Input: (defclass/a dbd-postgres (dbi-driver) ())

Output:
(defmacro defclass/a (name superclasses slots &rest class-options)
  `(progn
     (defclass ,name ,superclasses ,slots ,@class-options)
     (deftype ,(intern (format nil "<~A>" (symbol-name name))) () ',name)
     (setf (find-class ',(intern (format nil "<~A>" (symbol-name name))))
           (find-class ',name))))

(progn (defclass dbd-postgres (dbi-driver) nil) (deftype <dbd-postgres> nil (quote dbd-postgres)) (setf (find-class (quote <dbd-postgres>)) (find-class (quote dbd-postgres))))


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

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

Input:
(with-access nil
    :key
  nil)

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

(let ((#:|val243| :key))
  (declare (ignorable #:|val243|))
  (symbol-macrolet ()
    nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
;; Building a closure with mutable behavior requires manual forwarding
(let ((counter 0)
      (impl (lambda (n) (incf counter n))))
  (lambda (&rest args)
    (apply impl args)))

;; To change behavior: build an entirely new closure

Issue: Need mutable closure behavior changeable at runtime, with implicit 'this' pointing to current implementation

Input:
;; Building a closure with mutable behavior requires manual forwarding
(let ((counter 0)
      (impl (lambda (n) (incf counter n))))
  (lambda (&rest args)
    (apply impl args)))

;; To change behavior: build an entirely new closure

Output:
(defmacro alet (letargs &rest body)
  `(let ((this) ,@letargs)
     (setq this ,@(last body))
     ,@(butlast body)
     (lambda (&rest params)
       (apply this params))))

;; (alet ((acc 0))
;;   (format t "Initialized~%")
;;   (lambda (n) (incf acc n)))
;;
;; Returns a forwarding closure where 'this' can be swapped.
;; The lambda inside can (setq this #'new-fn) to hotpatch.


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

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

Input: (dreletf* nil)

Output: (defmacro DRELETF* ...)


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

Issue: Macro call that should be transformed by CLASS-STEALTH-MIXINS

Input: (class-stealth-mixins 'some-name)

Output: (defmacro CLASS-STEALTH-MIXINS ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn "SELECT last_insert_rowid() AS last_insert_id") (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

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

Input: (with-prepared-query query (conn "SELECT last_insert_rowid() AS last_insert_id") (or (first (dbi:fetch (dbi:execute query) :format :values)) 0))

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

(call-with-prepared-query conn "SELECT last_insert_rowid() AS last_insert_id" (lambda (query) (or (first (dbi.driver:fetch (dbi.driver:execute query) :format :values)) 0)) :use-prepare-cached nil)


Instruction:
Generate a defmacro form that transforms code like this:
($map-reduce "foo" m r :query ($> "l" -9))

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

Input: ($map-reduce "foo" m r :query ($> "l" -9))

Output:
(defmacro $ (&rest args)
  `(kv ,@args))

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


Instruction:
Generate a defmacro form that transforms code like this:
(with-effective-qualifier generic-function qualifier `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list (dispatch ,generic-function ,qualifier ,specialized-lambda-list) ,@body))

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

Input: (with-effective-qualifier generic-function qualifier `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list (dispatch ,generic-function ,qualifier ,specialized-lambda-list) ,@body))

Output:
(defmacro with-effective-qualifier (gf-name qualifier &body body)
  "take generic function and a symbol bound to a qualifier and mask that symbol with the effective qualifier.

The effective qualifier is the default qualifier for the given generic function should there be one defined by
a define-hook-generic form."
  `(let ((,qualifier
          (effective-qualifier ,gf-name ,qualifier)))
     ,@body))

(let ((qualifier (effective-qualifier generic-function qualifier))) (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) (dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr specialized-lambda-list :kind 0)) #S(sb-impl::comma :expr body :kind 2))))


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

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

Input:
(-<>>
  nil
  nil)

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite second (expr) `(cadr ,(second expr)))

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(make-obsolete mustache-type version "0.10.0")

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

Input: (make-obsolete mustache-type version "0.10.0")

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

(defun mustache-type (&rest args) #A((31) base-char . "Return the CL-MUSTACHE version.") (warn (quote deprecation-warning) :name (quote mustache-type) :replacement (quote version) :since "0.10.0") (apply (quote version) args))


Instruction:
Generate a defmacro form that transforms code like this:
(define-error flow-id-must-be-specified-co (:error-type varjo-critical-error) () "code objects must be given a flow id when created")

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

Input: (define-error flow-id-must-be-specified-co (:error-type varjo-critical-error) () "code objects must be given a flow id when created")

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 flow-id-must-be-specified-co (:error-type varjo-critical-error :prefix "Varjo") nil "code objects must be given a flow id when created")


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

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

Input: (infix)

Output: (defmacro INFIX ...)


Instruction:
Generate a defmacro form that transforms code like this:
(with-additional-indent (reporter stream "✓ ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (with-color (:gray :stream stream) (format/indent reporter stream description))) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (terpri stream))

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

Input: (with-additional-indent (reporter stream "✓ ") (let ((description (possible-report-description report)) (duration (slot-value report 'duration))) (when description (with-color (:gray :stream stream) (format/indent reporter stream description))) (when duration (format stream " ") (print-duration stream duration (slot-value report 'slow-threshold)))) (terpri stream))

Output:
(defmacro with-additional-indent ((reporter stream control-string &rest format-arguments) &body body)
  (declare (ignorable reporter stream control-string))
  (let* ((need-new-line (ppcre:scan "^~&" control-string))
         (string (apply #'format nil control-string format-arguments))
         (increment (length string)))
    `(with-slots (indent-space) reporter
       (let* ((first-line-indent (indent indent-space))
              (*additional-indent* ,(if need-new-line
                                        increment
                                        `(+ *additional-indent*
                                            ,increment))))
         (declare (ignorable first-line-indent))
         ,(if need-new-line
              `(progn (fresh-line stream)
                      (write-string first-line-indent ,stream)
                      ;; because we just started a new line, we
                      ;; should use format/indent to write string
                      ;; taking into account a main indentation level
                      (format/indent ,reporter ,stream ,string))
              ;; otherwise, just output our prefix
              `(write-string ,string ,stream))

         ,@body))))

(with-slots (indent-space) reporter (let* ((first-line-indent (indent indent-space)) (*additional-indent* (+ *additional-indent* 2))) (declare (ignorable first-line-indent)) (write-string "✓ " stream) (let ((description (possible-report-description report)) (duration (slot-value report (quote duration)))) (when description (with-color (:gray :stream stream) (format/indent reporter stream description))) (when duration (format stream " ") (print-duration stream duration (slot-value report (quote slow-threshold))))) (terpri stream)))


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

What needs to change: Macro call that should be transformed by WITH-CACHED-READER-CONDITIONALS

Input:
(with-cached-reader-conditionals
  nil)

Output: (defmacro WITH-CACHED-READER-CONDITIONALS ...)

(call-with-cached-reader-conditionals (lambda () nil))


Instruction:
Generate a defmacro form that transforms code like this:
(with-prepared-query query (conn (format nil "SELECT pg_get_serial_sequence('~A', '~A')" table-name column)) (let ((seq (first (dbi:fetch (dbi:execute query) :format :values)))) (if (eq seq :null) nil seq)))

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

Input: (with-prepared-query query (conn (format nil "SELECT pg_get_serial_sequence('~A', '~A')" table-name column)) (let ((seq (first (dbi:fetch (dbi:execute query) :format :values)))) (if (eq seq :null) nil seq)))

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

(call-with-prepared-query conn (format nil "SELECT pg_get_serial_sequence('~A', '~A')" table-name column) (lambda (query) (let ((seq (first (dbi.driver:fetch (dbi.driver:execute query) :format :values)))) (if (eq seq :null) nil seq))) :use-prepare-cached nil)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(fail-compile (defun foo () (frob)) style-warning)

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

Input: (fail-compile (defun foo () (frob)) style-warning)

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

(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (fail-expansion (defun foo nil (frob)))) :value-form (quote (nth-value 3 (try-compile (quote (defun foo nil (frob))) (quote style-warning)))) :body (lambda nil (nth-value 3 (try-compile (quote (defun foo nil (frob))) (quote style-warning)))) :expected (quote style-warning) :comparison (quote typep)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym :minimize :min)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym :minimize :min)

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-binary-op-mapping-definer define-binary-ops `(progn (declaim (inline ,op)) (defun ,op (x y) (,cl x y))))

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

Input: (define-binary-op-mapping-definer define-binary-ops `(progn (declaim (inline ,op)) (defun ,op (x y) (,cl x y))))

Output:
(defmacro define-binary-op-mapping-definer (name &body body)
  `(defmacro ,name (&rest map)
     `(progn ,@(loop for (vacietis cl) on map by #'cddr collect
                    (let ((op (find-symbol (symbol-name vacietis) '#:vacietis.c)))
                      ,@body)))))

(defmacro define-binary-ops (&rest map) (sb-int:quasiquote (progn #S(sb-impl::comma :expr (loop for (vacietis cl) on map by (function cddr) collect (let ((op (find-symbol (symbol-name vacietis) (quote #:vacietis.c)))) (sb-int:quasiquote (progn (declaim (inline #S(sb-impl::comma :expr op :kind 0))) (defun #S(sb-impl::comma :expr op :kind 0) (x y) (#S(sb-impl::comma :expr cl :kind 0) x y)))))) :kind 2))))


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

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

Input: (let+ 'some-name)

Output: (defmacro LET+ ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(assoc-cdr :first-name uinfo)

Issue: Macro call that should be transformed by assoc-cdr

Input: (assoc-cdr :first-name uinfo)

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

(cdr (assoc :first-name uinfo :test (function eql)))


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

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

Input:
(ps-once-only nil
  nil)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-bug invalid-special-function-arg-spec (:error-type varjo-critical-error) (name spec) "The special function named ~s has an invalid argument spec: ~a Please report this bug on github" name spec)

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

Input: (define-bug invalid-special-function-arg-spec (:error-type varjo-critical-error) (name spec) "The special function named ~s has an invalid argument spec: ~a Please report this bug on github" name spec)

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 invalid-special-function-arg-spec (:error-type varjo-critical-error :prefix "Varjo Bug") (name spec) "The special function named ~s has an invalid argument spec: ~a Please report this bug on github" name spec)


Instruction:
Generate a defmacro form that transforms code like this:
(with-decoder-simple-list-semantics (flet ((safe-symbols-parsing (name) (or (find-symbol name *json-symbols-package*) (error "unknown symbols not allowed")))) (let ((good-symbols "{\"car\":1,\"cdr\":2}") (bad-symbols "{\"could-be\":1,\"a-denial-of-service-attack\":2}") (*json-symbols-package* (find-package :cl)) (*identifier-name-to-key* #'safe-symbols-parsing)) (is (equal '((car . 1) (cdr . 2)) (decode-json-from-string good-symbols))) (signals error (decode-json-from-string bad-symbols)))))

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

Input: (with-decoder-simple-list-semantics (flet ((safe-symbols-parsing (name) (or (find-symbol name *json-symbols-package*) (error "unknown symbols not allowed")))) (let ((good-symbols "{\"car\":1,\"cdr\":2}") (bad-symbols "{\"could-be\":1,\"a-denial-of-service-attack\":2}") (*json-symbols-package* (find-package :cl)) (*identifier-name-to-key* #'safe-symbols-parsing)) (is (equal '((car . 1) (cdr . 2)) (decode-json-from-string good-symbols))) (signals error (decode-json-from-string bad-symbols)))))

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) (flet ((safe-symbols-parsing (name) (or (find-symbol name *json-symbols-package*) (error "unknown symbols not allowed")))) (let ((good-symbols "{\"car\":1,\"cdr\":2}") (bad-symbols "{\"could-be\":1,\"a-denial-of-service-attack\":2}") (*json-symbols-package* (find-package :cl)) (*identifier-name-to-key* (function safe-symbols-parsing))) (is (equal (quote ((car . 1) (cdr . 2))) (decode-json-from-string good-symbols))) (signals error (decode-json-from-string bad-symbols)))))


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

Issue: Macro call that should be transformed by define-simple-documentation-lookup

Input: (define-simple-documentation-lookup type cl:type)

Output:
(defmacro define-simple-documentation-lookup (class documentation-type)
  `(defmethod documentation ((,class ,class))
     ,(if (eql documentation-type T)
          `(cl:documentation (object ,class) 'T)
          `(cl:documentation (designator ,class) ',documentation-type))))

(defmethod documentation ((type type)) (common-lisp:documentation (designator type) (quote common-lisp:type)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-accumulation-binding reducing ((var *unbound*) form &key (by NIL by-p)) (unless by-p (error ":BY argument required for REDUCING binding.")) `(cond ((eq ,var *unbound*) (setf ,var ,form)) (T (setf ,var (funcall ,by ,var ,form)))))

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

Input: (define-accumulation-binding reducing ((var *unbound*) form &key (by NIL by-p)) (unless by-p (error ":BY argument required for REDUCING binding.")) `(cond ((eq ,var *unbound*) (setf ,var ,form)) (T (setf ,var (funcall ,by ,var ,form)))))

Output:
(defmacro define-accumulation-binding (name (var &rest args) &body body)
  `(define-form-binding ,name (,var ,@args)
     ,@(form-fiddle:lambda-declarations `(lambda () ,@body))
     (values
      (progn ,@(form-fiddle:lambda-forms `(lambda () ,@body)))
      (delist var))))

(define-form-binding reducing ((var *unbound*) form &key (by nil by-p)) (values (progn (unless by-p (error ":BY argument required for REDUCING binding.")) (sb-int:quasiquote (cond ((eq #S(sb-impl::comma :expr var :kind 0) *unbound*) (setf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr form :kind 0))) (t (setf #S(sb-impl::comma :expr var :kind 0) (funcall #S(sb-impl::comma :expr by :kind 0) #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr form :kind 0))))))) (delist var)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-html (:table (dotimes (i 1000) (:tr (dotimes (i 10) (:td (1+ i)))))))

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

Input: (with-html (:table (dotimes (i 1000) (:tr (dotimes (i 10) (:td (1+ i)))))))

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 (with-tag (:table) (dotimes (i 1000) (with-tag (:tr) (dotimes (i 10) (with-tag (:td) (1+ i))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-case-aware-token-p-function pp-stdc-pragma-p find-pragma-name with-c-syntax.pragma-name:|STDC|)

Pattern to recognize: Macro call that should be transformed by define-case-aware-token-p-function

Input: (define-case-aware-token-p-function pp-stdc-pragma-p find-pragma-name with-c-syntax.pragma-name:|STDC|)

Output:
(defmacro define-case-aware-token-p-function (function-name find-symbol-function symbol)
  `(defun ,function-name (token &optional (readtable-case (readtable-case *readtable*)))
     (and (symbolp token)
          (eq (,find-symbol-function (string token) readtable-case)
              ',symbol))))

(defun pp-stdc-pragma-p (token &optional (readtable-case (readtable-case *readtable*))) (and (symbolp token) (eq (find-pragma-name (string token) readtable-case) (quote with-c-syntax.pragma-name:stdc))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-error could-not-find-function (:error-type varjo-critical-error) (name) "No function called '~s' was found in this environment" name)

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

Input: (define-error could-not-find-function (:error-type varjo-critical-error) (name) "No function called '~s' was found in this environment" 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 could-not-find-function (:error-type varjo-critical-error :prefix "Varjo") (name) "No function called '~s' was found in this environment" name)


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

Issue: Macro call that should be transformed by DRELET*

Input: (drelet* nil)

Output: (defmacro DRELET* ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-standard-readtable
  nil
  nil)

Problem: Macro call that should be transformed by WITH-STANDARD-READTABLE

Input:
(with-standard-readtable
  nil
  nil)

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

(bind ((*readtable* (with-standard-io-syntax (copy-readtable *readtable*))))
  nil
  nil)


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

Issue: Macro call that should be transformed by action

Input: (action (:after node-application node) (multiple-value-bind (new-node new-changed?) (maybe-sink-application-into-rator node) (when new-changed? (setf changed? t) new-node)))

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

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
($op* op l)

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

Input: ($op* op l)

Output:
(defmacro $ (&rest args)
  `(kv ,@args))


Instruction:
Generate a defmacro form that transforms code like this:
(ensure-getf options :ignorable ignorable)

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

Input: (ensure-getf options :ignorable ignorable)

Output:
(defmacro ensure-getf (place key &optional default)
  (once-only (key default)
    `(setf (getf ,place ,key) (getf ,place ,key ,default))))

(let ((#:key173 :ignorable) (#:default174 ignorable)) (setf (getf options #:key173) (getf options #:key173 #:default174)))


Instruction:
Generate a defmacro form that transforms code like this:
(action (:after node-direct-application) #'apply-specialization)

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

Input: (action (:after node-direct-application) #'apply-specialization)

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

(make-action (quote :after) (quote node-direct-application) (function apply-specialization))


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

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

Input: (rem-bops nil)

Output: (defmacro REM-BOPS ...)

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


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

Problem: Macro call that should be transformed by MATCH

Input: (match nil)

Output: (defmacro MATCH ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(sctypecase (car x) (string (setf it :ok)))

Problem: Macro call that should be transformed by sctypecase

Input: (sctypecase (car x) (string (setf it :ok)))

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

(symbolic ctypecase (car x) (string (setf it :ok)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-env [ht-equalp (copy-list '(4 5 6))])

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

Input: (with-env [ht-equalp (copy-list '(4 5 6))])

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

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


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

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

Input: (defmessage nil nil)

Output: (defmacro DEFMESSAGE ...)

(progn
 (eval-when (:compile-toplevel) (proclaim `(ftype function ,'nil)))
 (aprog1 (ensure-message 'nil :lambda-list 'nil)))


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

Issue: 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:
(defun/1 fflush (fd) (unless (eql fd NULL) (finish-output (fd-stream fd))) 0)

Write a macro that addresses: Macro call that should be transformed by defun/1

Input: (defun/1 fflush (fd) (unless (eql fd NULL) (finish-output (fd-stream fd))) 0)

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 fflush (fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (unless (eql fd null) (finish-output (fd-stream fd))) 0) (defparameter fflush (vacietis.c:mkptr& (symbol-function (quote fflush)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(def-slot-annotation required () (when (plist-member slot-options :initform) (error "Required slot ~A must not have :initform" slot-name)) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (setf (getf slot-options :initform) `(required-argument ,(getf slot-options :initarg))))

Write a macro that addresses: Macro call that should be transformed by def-slot-annotation

Input: (def-slot-annotation required () (when (plist-member slot-options :initform) (error "Required slot ~A must not have :initform" slot-name)) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (setf (getf slot-options :initform) `(required-argument ,(getf slot-options :initarg))))

Output:
(defmacro def-slot-annotation (name args &body body)
  (with-gensyms (slot-specifier)
    `(defannotation ,name ,(append args (list slot-specifier))
         (:inline t :arity ,(1+ (length args)))
       (destructuring-bind (slot-name . slot-options)
           (if (consp ,slot-specifier)
               ,slot-specifier
               (list ,slot-specifier))
         ,@body
         (cons slot-name slot-options)))))

(defannotation required (#:slot-specifier123) (:inline t :arity 1) (destructuring-bind (slot-name . slot-options) (if (consp #:slot-specifier123) #:slot-specifier123 (list #:slot-specifier123)) (when (plist-member slot-options :initform) (error "Required slot ~A must not have :initform" slot-name)) (unless (plist-member slot-options :initarg) (setf (getf slot-options :initarg) (make-keyword slot-name))) (setf (getf slot-options :initform) (sb-int:quasiquote (required-argument #S(sb-impl::comma :expr (getf slot-options :initarg) :kind 0)))) (cons slot-name slot-options)))


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

Problem: Macro call that should be transformed by DEFUN*

Input:
(defun* nil
    (progn))

Output: (defmacro DEFUN* ...)


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

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

Input: (define-language nil nil)

Output: (defmacro DEFINE-LANGUAGE ...)

(progn
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass nil (nil) nil))
 (define-language-macro nil))


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

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

Input:
(-<>
  nil
  (progn))

Output: (defmacro -<> ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(fmap (lambda (chars) (destructuring-bind (a b c d) chars (code-char (+ (* 4096 (digit-char-p a 16)) (* 256 (digit-char-p b 16)) (* 16 (digit-char-p c 16)) (digit-char-p d 16))))) (funcall (*> (char #\\) (alt (char #\u) (char #\U)) (count 4 #'hex)) offset))

Issue: Macro call that should be transformed by fmap

Input: (fmap (lambda (chars) (destructuring-bind (a b c d) chars (code-char (+ (* 4096 (digit-char-p a 16)) (* 256 (digit-char-p b 16)) (* 16 (digit-char-p c 16)) (digit-char-p d 16))))) (funcall (*> (char #\\) (alt (char #\u) (char #\U)) (count 4 #'hex)) offset))

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) (funcall (*> (char #\REVERSE_SOLIDUS) (alt (char #\LATIN_SMALL_LETTER_U) (char #\LATIN_CAPITAL_LETTER_U)) (count 4 (function hex))) offset) (if (failure? res) (fail next) (values (funcall (lambda (chars) (destructuring-bind (a b c d) chars (code-char (+ (* 4096 (digit-char-p a 16)) (* 256 (digit-char-p b 16)) (* 16 (digit-char-p c 16)) (digit-char-p d 16))))) res) next)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-find-c-readtable-name-methods c-reader-level-1 1)

Problem: Macro call that should be transformed by define-find-c-readtable-name-methods

Input: (define-find-c-readtable-name-methods c-reader-level-1 1)

Output:
(defmacro define-find-c-readtable-name-methods (base-readtable-name level)
  (check-type base-readtable-name symbol)
  (check-type level integer)
  (loop with case-modes = '(nil :upcase :downcase :preserve :invert)
        for mode in case-modes
        as name = (format-symbol :with-c-syntax.core "~A~@[-~A~]"
                                 base-readtable-name mode)
        collect `(defmethod find-c-readtable-name
                     ((level (eql ,level)) (readtable-case (eql ,mode)))
                   ',name)
          into bodies
        finally
           (return `(progn ,@bodies))))

(progn (defmethod find-c-readtable-name ((level (eql 1)) (readtable-case (eql nil))) (quote c-reader-level-1)) (defmethod find-c-readtable-name ((level (eql 1)) (readtable-case (eql :upcase))) (quote c-reader-level-1-upcase)) (defmethod find-c-readtable-name ((level (eql 1)) (readtable-case (eql :downcase))) (quote c-reader-level-1-downcase)) (defmethod find-c-readtable-name ((level (eql 1)) (readtable-case (eql :preserve))) (quote c-reader-level-1-preserve)) (defmethod find-c-readtable-name ((level (eql 1)) (readtable-case (eql :invert))) (quote c-reader-level-1-invert)))


Instruction:
Define a macro that eliminates this repetitive pattern:
;; Explicit continuation-passing is verbose
(defun fact-cps (n cont)
  (if (zerop n)
      (funcall cont 1)
      (fact-cps (- n 1)
                (lambda (x) (funcall cont (* n x))))))

;; Every function must take an explicit continuation parameter.
;; Every call must thread the continuation through.
;; Simple sequential code becomes deeply nested.

Issue: Manual continuation-passing style requires explicit continuation parameters and nested lambdas — want syntactic sugar for CPS

Input:
;; Explicit continuation-passing is verbose
(defun fact-cps (n cont)
  (if (zerop n)
      (funcall cont 1)
      (fact-cps (- n 1)
                (lambda (x) (funcall cont (* n x))))))

;; Every function must take an explicit continuation parameter.
;; Every call must thread the continuation through.
;; Simple sequential code becomes deeply nested.

Output:
(defmacro =lambda (parms &body body)
  `#'(lambda (*cont* ,@parms) ,@body))

(defmacro =defun (name parms &body body)
  (let ((f (intern (concatenate 'string
                                "=" (symbol-name name)))))
    `(progn
       (defmacro ,name ,parms
         `(,',f *cont* ,,@parms))
       (defun ,f (*cont* ,@parms) ,@body))))

(defmacro =bind (parms expr &body body)
  `(let ((*cont* #'(lambda ,parms ,@body))) ,expr))

(defmacro =values (&rest retvals)
  `(funcall *cont* ,@retvals))

;; (=defun fact (n)
;;   (if (zerop n)
;;       (=values 1)
;;       (=bind (x) (fact (- n 1))
;;         (=values (* n x)))))
;;
;; =lambda: creates a CPS function (takes *cont* as first arg)
;; =defun: defines a CPS function + a macro for clean call syntax
;; =bind: captures *cont* as the rest of the computation
;; =values: sends values to the current continuation
;;
;; The code looks sequential but compiles to CPS.
;; =bind marks where a continuation is captured.


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-shell-component less :input-type "less" :output-type "css" :shell-command "lessc")

Issue: Macro call that should be transformed by define-shell-component

Input: (define-shell-component less :input-type "less" :output-type "css" :shell-command "lessc")

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

(define-component less :input-type "less" :output-type "css" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run (list "lessc" input-pathname output-pathname) :show t)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lret ((vect (prepare-int-range start stop step))) (fill-int-range! vect start stop step))

Problem: Macro call that should be transformed by lret

Input: (lret ((vect (prepare-int-range start stop step))) (fill-int-range! vect start stop step))

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

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

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

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

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

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

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

(lret-aux let ((vect (prepare-int-range start stop step))) (fill-int-range! vect start stop step))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is (every #'test-failure-p results))

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

Input: (is (every #'test-failure-p results))

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 ((#:e208 (function test-failure-p)) (#:a209 results)) (if (progn (every #:e208 #:a209)) (add-result (quote test-passed) :test-expr (quote (every (function test-failure-p) results))) (process-failure (quote (every (function test-failure-p) results)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote results) #:a209 (quote every) #:e208)))


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

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

Input: (-> :p (v) (setf result v) (mt:open-latch latch))

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

(atomically :p (v) (setf result v) (cl-muth:open-latch latch))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-html-string (:raw "Very very very very very very very very very very very very very very very very very very very very very very very very long line"))

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

Input: (with-html-string (:raw "Very very very very very very very very very very very very very very very very very very very very very very very very long line"))

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

(with-output-to-string (*html*) (with-html (:raw "Very very very very very very very very very very very very very very very very very very very very very very very very long line")))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(-> :g () (mt:open-latch latch))

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

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

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(*> +consume-space+ +close-brace+)

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

Input: (*> +consume-space+ +close-brace+)

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 (#:*>-offset181) (multiple-value-bind (#:*>-res182 #:*>-next183) (funcall +consume-space+ #:*>-offset181) (if (ok? #:*>-res182) (funcall +close-brace+ #:*>-next183) (fail #:*>-next183))))


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

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

Input: (collect-hash nil nil)

Output: (defmacro COLLECT-HASH ...)

(common-lisp:let* ((#:out-138 (make-hash-table)))
  (common-lisp:let ((#:generator-142 (generator nil))
                    #:values-134
                    (#:generator-140 (generator nil))
                    #:keys-133)
    (declare (type generator #:generator-142)
             (type generator #:generator-140))
    (tagbody
     #:ll-143
      (setq #:values-134 (next-in #:generator-142 (go end)))
      (setq #:keys-133 (next-in #:generator-140 (go end)))
      (setf (gethash #:keys-133 #:out-138) #:values-134)
      (go #:ll-143)
     end)
    #:out-138))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(form &aux (result T))

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

Input: (form &aux (result T))

Output:
(defmacro for (&environment env bindings &body body)
  (let ((*environment* env))
    (multiple-value-bind (bind-init bind-forms bind-exit bind-post) (convert-bindings bindings)
      (multiple-value-bind (clause-init body-forms clause-exit) (convert-clauses body)
        `(with-interleaving
           ,@bind-init
           ,@clause-init
           (with-for-block ()
             (with-for-tagbody
                 (progn ,@bind-forms
                        ,@body-forms
                        ,@bind-post)
               (return-for
                ,@clause-exit
                ,@bind-exit))))))))


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

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

Input: (defsynonym maximize :max)

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(regex-apropos-aux (regex packages case-insensitive) (print-symbol-info symbol))

Issue: Macro call that should be transformed by regex-apropos-aux

Input: (regex-apropos-aux (regex packages case-insensitive) (print-symbol-info symbol))

Output:
(defmacro regex-apropos-aux ((regex packages case-insensitive &optional return-form)
                             &body body)
  "Auxiliary macro used by REGEX-APROPOS and REGEX-APROPOS-LIST.
Loops through PACKAGES and executes BODY with SYMBOL bound to each
symbol which matches REGEX.  Optionally evaluates and returns
RETURN-FORM at the end.  If CASE-INSENSITIVE is true and REGEX isn't
already a scanner, a case-insensitive scanner is used."
  (with-rebinding (regex)
    (with-unique-names (scanner %packages hash)
      `(let* ((,scanner (create-scanner ,regex
                         :case-insensitive-mode
                         (and ,case-insensitive
                              (not (functionp ,regex)))))
              (,%packages (or ,packages
                             (list-all-packages)))
              (,hash (make-hash-table :test #'eq)))
        (do-with-all-symbols (symbol ,%packages)
          (unless (gethash symbol ,hash)
            (when (scan ,scanner (symbol-name symbol))
              (setf (gethash symbol ,hash) t)
              ,@body)))
        ,return-form))))

(let ((#:regex149 regex)) (let* ((#:scanner150 (create-scanner #:regex149 :case-insensitive-mode (and case-insensitive (not (functionp #:regex149))))) (#:%packages151 (or packages (list-all-packages))) (#:hash154 (make-hash-table :test (function eq)))) (with-package-iterator (#:next152 #:%packages151 :external :internal :inherited) (loop (multiple-value-bind (#:morep153 symbol) (#:next152) (unless #:morep153 (return nil)) (unless (gethash symbol #:hash154) (when (scan #:scanner150 (symbol-name symbol)) (setf (gethash symbol #:hash154) t) (print-symbol-info symbol))))))))


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

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

Input:
(sum-of nil
  nil)

Output: (defmacro SUM-OF ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(is-print (princ "ABCDEFGH") "ABCDEFGHIJKLMNO")

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

Input: (is-print (princ "ABCDEFGH") "ABCDEFGHIJKLMNO")

Output:
(defmacro is (got expected &rest args)
  (with-gensyms (duration result new-args desc)
    (once-only (expected)
      `(let* ((,new-args (list ,@args))
              (,desc (parse-description-and-test ,new-args)))
         (with-catching-errors (:description ,desc :expected ,expected)
           (with-duration ((,duration ,result) ,got)
             (test ,result ,expected ,new-args
                   :duration ,duration)))))))

(let ((#:expected175 "ABCDEFGHIJKLMNO") (#:desc176 nil)) (with-catching-errors (:description #:desc176 :expected #:expected175) (let* (#:duration173 (#:output172 (with-output-to-string (*standard-output*) (with-duration ((#:duration-inner174 #:output172) (princ "ABCDEFGH")) (declare (ignore #:output172)) (setq #:duration173 #:duration-inner174))))) (test #:output172 #:expected175 #:desc176 :duration #:duration173 :got-form (quote (princ "ABCDEFGH")) :test-fn (function string=) :report-expected-label "output"))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(sunless x (setf it :oops))

Problem: Macro call that should be transformed by sunless

Input: (sunless x (setf it :oops))

Output:
(defmacro sunless (test &body body)
  "Like UNLESS, except binds the test form to IT (via SYMBOL-MACROLET) for the
scope of the body. IT can be set with SETF."
  `(symbolic unless ,test ,@body))


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

Problem: Macro call that should be transformed by DEFGENERIC

Input: (defgeneric nil nil)

Output: (defmacro DEFGENERIC ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-shell-component sass :input-type "scss" :output-type "css" :shell-command "sass")

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

Input: (define-shell-component sass :input-type "scss" :output-type "css" :shell-command "sass")

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

(define-component sass :input-type "scss" :output-type "css" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run (list "sass" input-pathname output-pathname) :show t)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-error-for sffi-continuable-error)

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

Input: (define-simple-error-for sffi-continuable-error)

Output:
(defmacro define-simple-error-for (base-type &key name object-initarg)
  "Define a simple error subclassing from BASE-TYPE and a corresponding
function, analogous to ERROR, but also optionally taking the object
against which to err, and passing it to ERROR via the OBJECT-INITARG
keyword. The name of the simple error is constructed by prepending
'SIMPLE-' to BASE-TYPE.
Whether or not the error signaller will require and pass the
object is specified by OBJECT-INITARG being non-NIL."
  `(define-simple-condition-for ,base-type :object-initarg ,object-initarg :simple-condition-type simple-error :signaler error
                                ,@(when name `(:name ,name))))

(define-simple-condition-for sffi-continuable-error :object-initarg nil :simple-condition-type simple-error :signaler error)


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

Issue: Macro call that should be transformed by QUASIQUOTE

Input: (quasiquote nil nil)

Output: (defmacro QUASIQUOTE ...)

(let ((#:source122 nil))
  (%quote #:source122 'nil))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defjs at() (let ((arr (make-array))) (setf (aref arr 0) 10) (setf (aref arr 1) 20) (setf (aref arr 2) 30) (setf (aref arr 4) 40) (setf (aref arr 5) 80) (return (aref arr 2))))

Problem: Macro call that should be transformed by defjs

Input: (defjs at() (let ((arr (make-array))) (setf (aref arr 0) 10) (setf (aref arr 1) 20) (setf (aref arr 2) 30) (setf (aref arr 4) 40) (setf (aref arr 5) 80) (return (aref arr 2))))

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 (let ((arr (make-array))) (setf (aref arr 0) 10) (setf (aref arr 1) 20) (setf (aref arr 2) 30) (setf (aref arr 4) 40) (setf (aref arr 5) 80) (return (aref arr 2))))))) (setf (gethash (quote at) *js-definitions*) js-body) (defun at nil (get-element "retval" (car (docs (db.eval js-body))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-trace-sql (execute-with-retry query binds))

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

Input: (with-trace-sql (execute-with-retry query binds))

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

(let ((*sql-execution-hooks* (cons (function trace-sql) *sql-execution-hooks*))) (execute-with-retry query binds))


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

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

Input: (assoc-cdr :userinfo--endpoint disc)

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

(cdr (assoc :userinfo--endpoint disc :test (function eql)))