[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))

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

(with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))

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

;; macroexpand:
(if *enable-colors* (if (or (eq :cyan :gray) (eq :cyan :grey) (eq :cyan +gray+) (eq :cyan +grey+)) (with-gray stream (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count)) (cl-ansi-text:with-color (:cyan :stream stream) (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count))) (progn (format/indent reporter stream "● ~D test~:*~P skipped" skipped-count)))


[User]
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite sixth (expr) `(cadr (cddddr ,(second expr))))

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

(define-modf-rewrite sixth (expr) `(cadr (cddddr ,(second expr))))

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(defclass/a dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store)))

Problem: Macro call that should be transformed by defclass/a

(defclass/a dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store)))

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

;; macroexpand:
(progn (defclass dbd-sqlite3-query (dbi-query) ((store :initarg :store :initform t :accessor sqlite3-use-store))) (deftype <dbd-sqlite3-query> nil (quote dbd-sqlite3-query)) (setf (find-class (quote <dbd-sqlite3-query>)) (find-class (quote dbd-sqlite3-query))))


[User]
Generate a defmacro form that transforms code like this:
(bind (((:struct metabang-bind-test-1- (my-a a) c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (list c my-a))

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

(bind (((:struct metabang-bind-test-1- (my-a a) c) (make-metabang-bind-test-1 :a 1 :b 2 :c 3))) (list c my-a))

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

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

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

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

;; macroexpand:
(let* ((#:|values-190| (make-metabang-bind-test-1 :a 1 :b 2 :c 3)) (my-a (metabang-bind-test-1-a #:|values-190|)) (c (metabang-bind-test-1-c #:|values-190|))) (declare (ignorable #:|values-190|)) (progn (list c my-a)))


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

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

(js nil (progn))

[Assistant]
(defmacro JS ...)

;; macroexpand:
(ps
  nil
  (progn))


[User]
Generate a defmacro form that transforms code like this:
(with-yield-binds (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by #'cddr collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type 'fields-clause) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key #'scoped-clause-clause :test #'equalp :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) #'scoped-merging-yield) scoped-clauses :initial-value nil)))))

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

(with-yield-binds (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by #'cddr collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type 'fields-clause) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key #'scoped-clause-clause :test #'equalp :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) #'scoped-merging-yield) scoped-clauses :initial-value nil)))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~{~A~^ ~}" (sql-statement-name (car (composed-statement-statements statement))) (loop for (type original-scoped-clauses) on grouped-clauses by (function cddr) collect (let ((scoped-clauses original-scoped-clauses)) (when (and (eq type (quote fields-clause)) (some (lambda (clause) (and (null (select-statement-table-name (scoped-clause-statement clause))) (some (lambda (field) (string= "*" (typecase field (as-op (sql-symbol-name (as-op-right field))) (sql-symbol (sql-symbol-name field))))) (sql-splicing-list-elements (fields-clause-statement (scoped-clause-clause clause)))))) scoped-clauses)) (setf scoped-clauses (list (make-scoped-clause (make-clause :fields :*) (make-statement :select))))) (setf scoped-clauses (delete-duplicates scoped-clauses :key (function scoped-clause-clause) :test (function equalp) :from-end t)) (reduce (if has-join-clause-p (lambda (a b) (scoped-merging-yield a b :with-table-names t)) (function scoped-merging-yield)) scoped-clauses :initial-value nil))))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Generate a defmacro form that transforms code like this:
(c-assert (member self (kids (fm-parent self))))

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

(c-assert (member self (kids (fm-parent self))))

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

;; macroexpand:
(unless *stop* (unless (member self (kids (fm-parent self))) (c-break "failed assertion: ~a" (quote (member self (kids (fm-parent self)))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:div (:textarea "123")))

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

(with-html-string (:div (:textarea "123")))

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

;; macroexpand:
(with-output-to-string (*html*) (with-html (:div (:textarea "123"))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-yield (do-generator (x (list->generator data)) (yield x)))

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

(with-yield (do-generator (x (list->generator data)) (yield x)))

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

;; macroexpand:
(let (#:g141 #:g142) (with-call/cc (labels ((yield (&rest values) (setf #:g142 values) (let/cc k (setf #:g141 k)))) (do-generator (x (list->generator data)) (yield x)) (setf #:g141 nil))) (gen-lambda nil (cond ((null #:g141) (quote generator-stop)) (t (let ((current #:g142)) (funcall #:g141 nil) (apply (function values) (funcall values-handler current)))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-decoder-simple-list-semantics (let ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))

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

(with-decoder-simple-list-semantics (let ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))

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

;; macroexpand:
(with-shadowed-custom-vars (set-decoder-simple-list-semantics) (let ((*json-symbols-package* (find-package :json-test)) result) (setf result (json-rpc:invoke-rpc "{\"method\":\"secretmethod\",\"params\":[1,2],\"id\":\"my id\"}")) (json-bind (result error id) result (is-false result) (is-true error) (is (string= id "my id")))))


[User]
Generate a defmacro form that transforms code like this:
(with-iterators ((it1 seq1 :start start1 :end end1 :from-end from-end) (it2 seq2 :start start2 :end end2 :from-end from-end)) (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (cl:incf pos)))))

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

(with-iterators ((it1 seq1 :start start1 :end end1 :from-end from-end) (it2 seq2 :start start2 :end end2 :from-end from-end)) (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (cl:incf pos)))))

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

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

   SEQS:

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

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

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

   FORMS:

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

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

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

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

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

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

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

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

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

                  ,@body))

             ;; Tagbody

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

             ;; Bindings

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

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

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

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

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

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

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

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

;; macroexpand:
(symbol-macrolet nil (let* ((#:it165 (iterator seq1 :start start1 :end end1 :from-end from-end)) (#:it168 (iterator seq2 :start start2 :end end2 :from-end from-end))) (symbol-macrolet ((iter-value-macros ((it1 . #:iter-value166) (it2 . #:iter-value169))) (iter-place-macros ((it1 . #:iter-place167) (it2 . #:iter-place170)))) (macrolet ((#:iter-value169 (pattern &body body) (symbol-macrolet ((it (quote #:it168)) (tag (quote #:end-tag164))) (with-destructure-pattern (var pattern) (body decl body) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) (let ((#S(sb-impl::comma :expr var :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl :kind 2) (advance #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr body :kind 2))))))) (#:iter-place170 (name more? &body body) (symbol-macrolet ((it (quote #:it168)) (tag (quote #:end-tag164))) (let ((body (sb-int:quasiquote (prog1 (progn #S(sb-impl::comma :expr body :kind 2)) (advance #S(sb-impl::comma :expr it :kind 0)))))) (with-variable-declarations ((decl-name name) (decl-more? more?)) forms body (sb-int:quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr name :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl-name :kind 2) #S(sb-impl::comma :expr (if more? (sb-int:quasiquote (let ((#S(sb-impl::comma :expr more? :kind 0) (not (endp #S(sb-impl::comma :expr it :kind 0))))) #S(sb-impl::comma :expr decl-more? :kind 2) #S(sb-impl::comma :expr forms :kind 0))) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) #S(sb-impl::comma :expr forms :kind 0)))) :kind 0)))))))) (macrolet ((#:iter-value166 (pattern &body body) (symbol-macrolet ((it (quote #:it165)) (tag (quote #:end-tag164))) (with-destructure-pattern (var pattern) (body decl body) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) (let ((#S(sb-impl::comma :expr var :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl :kind 2) (advance #S(sb-impl::comma :expr it :kind 0)) #S(sb-impl::comma :expr body :kind 2))))))) (#:iter-place167 (name more? &body body) (symbol-macrolet ((it (quote #:it165)) (tag (quote #:end-tag164))) (let ((body (sb-int:quasiquote (prog1 (progn #S(sb-impl::comma :expr body :kind 2)) (advance #S(sb-impl::comma :expr it :kind 0)))))) (with-variable-declarations ((decl-name name) (decl-more? more?)) forms body (sb-int:quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr name :kind 0) (at #S(sb-impl::comma :expr it :kind 0)))) #S(sb-impl::comma :expr decl-name :kind 2) #S(sb-impl::comma :expr (if more? (sb-int:quasiquote (let ((#S(sb-impl::comma :expr more? :kind 0) (not (endp #S(sb-impl::comma :expr it :kind 0))))) #S(sb-impl::comma :expr decl-more? :kind 2) #S(sb-impl::comma :expr forms :kind 0))) (sb-int:quasiquote (progn (when (endp #S(sb-impl::comma :expr it :kind 0)) (go #S(sb-impl::comma :expr tag :kind 0))) #S(sb-impl::comma :expr forms :kind 0)))) :kind 0)))))))) (tagbody (loop do (with-iter-place (e1 it1 more1?) (with-iter-place (e2 it2 more2?) (when (not (and more1? more2?)) (return-from mismatch (when (or more1? more2?) (compute-pos pos)))) (unless (funcall test (funcall key e1) (funcall key e2)) (return-from mismatch (compute-pos pos))) (incf pos)))) #:end-tag164))))))


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

Issue: Macro call that should be transformed by MATRIX-ECASE

(matrix-ecase 'some-name)

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

;; macroexpand:
(let ((#:g244 quote))
  (ecase #:g244))


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

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

(-<> nil)

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

;; macroexpand:
nil


[User]
Create a Common Lisp macro for the following transformation. Before code:
(modf place new-value)

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

(modf place new-value)

[Assistant]
(defmacro modf (place value &rest more &environment env)
  "Make a new object \(which may use some of the old object) such that PLACE
evaluates to VALUE.

MORE should have the form...

MORE : NIL
     | (TEMPORARY-BINDING ANOTHER-MODF-PLACE ANOTHER-VALUE . MORE)

Use it to specify a temporary binding for the new object created which will be
used in the subsequence MODF-PLACE NEW-VALUE pairs until the end of the MODF
form."
  (if more
      (destructuring-bind (next-symbol next-place next-value &rest next-more) more
        `(let ((,next-symbol ,(modf-expand value place nil env)))
           (modf ,next-place ,next-value ,@next-more)))
      (modf-expand value place nil env)))

;; macroexpand:
(let ((nil place)) new-value)


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

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

(fgather-result nil)

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

;; macroexpand:
(nil nil t)


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

Problem: Macro call that should be transformed by DEFMACRO+PS

(defmacro+ps nil
    nil)

[Assistant]
(defmacro DEFMACRO+PS ...)

;; macroexpand:
(progn
 (defmacro nil ())
 (defpsmacro nil
     nil))


[User]
Generate a defmacro form that transforms code like this:
(awhen (not (incf x)) t)

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

(awhen (not (incf x)) t)

[Assistant]
(defmacro awhen (test &body body)
  "Like WHEN, except binds the result of the test to IT (via LET) for the scope
of the body."
  `(anaphoric when ,test ,@body))

;; macroexpand:
(let ((it (not (incf x)))) (when it t))


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

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

(collect-ignore nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-169 (generator nil)))
  (declare (type generator #:generator-169))
  (tagbody #:ll-170 (next-in #:generator-169 (go end)) (go #:ll-170) end)
  nil)


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

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

(-<>> nil)

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

;; macroexpand:
nil


[User]
Create a Common Lisp macro for the following transformation. Before code:
(gen-lambda () (if (not data) 'generator-stop (prog1 data (setf data (cdr data)))))

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

(gen-lambda () (if (not data) 'generator-stop (prog1 data (setf data (cdr data)))))

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

;; macroexpand:
(let ((values-handler (create-values-handler))) (declare (ignorable values-handler)) (make-instance (quote basic-generator) :function (lambda nil (if (not data) (quote generator-stop) (prog1 data (setf data (cdr data)))))))


[User]
Define a macro that eliminates this repetitive pattern:
(defun/1 pow (x y) (expt x y))

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

(defun/1 pow (x y) (expt x y))

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

;; macroexpand:
(progn (defun pow (x y) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (expt x y)) (defparameter pow (vacietis.c:mkptr& (symbol-function (quote pow)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-mustache-character #\= (let ((arg-text (string-trim '(#\Space #\Tab #\=) arg-text))) (prog1 (make-instance 'delimiter-tag :text arg-text) (change-delimiter arg-text))))

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

(define-mustache-character #\= (let ((arg-text (string-trim '(#\Space #\Tab #\=) arg-text))) (prog1 (make-instance 'delimiter-tag :text arg-text) (change-delimiter arg-text))))

[Assistant]
(defmacro define-mustache-character (char &body body)
  `(set-mustache-character
    ,char (lambda (raw-text arg-text escapep start end)
            (declare (ignorable raw-text arg-text escapep start end)
                     (type simple-string raw-text arg-text)
                     (boolean escapep)
                     (offset start end))
            ,@body)))

;; macroexpand:
(set-mustache-character #\EQUALS_SIGN (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (let ((arg-text (string-trim (quote (#\Space #\Tab #\EQUALS_SIGN)) arg-text))) (prog1 (make-instance (quote delimiter-tag) :text arg-text) (change-delimiter arg-text)))))


[User]
Define a macro that eliminates this repetitive pattern:
(def-iter iterator-dropwhile (base-iter pred been-false) (dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (init-state (pred predicate) (base-iter (make-iterator iterable)))) (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values item t))) (values nil nil)))))

Issue: Macro call that should be transformed by def-iter

(def-iter iterator-dropwhile (base-iter pred been-false) (dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (init-state (pred predicate) (base-iter (make-iterator iterable)))) (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values item t))) (values nil nil)))))

[Assistant]
(defmacro def-iter (name state-vars (constructor-name constructor-params &body constructor-body)
                    &body next-body)
  "An anaphoric convenience macro which can be re-implemented to change how iterators are
  structured. Exposes the local `init-state` macro within `constructor-body`

  If you don't want to-use this macro (which I totally understand) just write constructors for your
  iterators returning 0-argument closures representing the `next` function and you'll be fine. This
  macro just helped me get through a lot of waffling during development

  Parameters
  ----------
  `name` is a synbol naming the iterator's backing state. However it's actually
  ignored, since PICL doesn't currently expose iterators' backing state

  `state-vars` is a list of symbols naming the iterator's state variables.

  The `constructor-name/params/body` will be `defun`'d to create the user-facing constructor
  function. In `constructor-body`, the return value should be an iterator or a call to local
  `init-state` macro

  `next-body` The definition of the `next` function for this iterator, which will be run in a
   lexical environment consisting of the state vars

  Both `constructor-body` and `next-body` are defined in the lexical environment of the `def-iter`
  form, and as such can access any lexical bindings not shadowed by the `constructor-params` and
  `state-vars` respectively

  The local `init-state` macro.
  ----------------------------
  The arguments to `init-state` should be of the form `(statevar-symbol value-form)`or
  `statevar-symbol`. In the first case, the value of `value-form` will be used to initialize the
  state variable named by `symbol`. In the second case, `statevar-symbol` is also used as the
  corresponding `value-form`

  Example
  -------
  What follows is a sample implementation of the `count` iterator using this macro
  ```
  (def-iter ignored-backing-name (curr-val step)
    (count (start step)
      (init-state (curr-val start) step))
    (prog1 curr-val (incf curr-val step))))
  ````"

  (declare (ignore name))
  (alexandria:with-gensyms (next-fname)
    (let ((docstring "Function had no docstring, so this one was inserted"))
      (when (and (cdr constructor-body) (stringp (car constructor-body)))
        (setf docstring (car constructor-body)
              constructor-body (cdr constructor-body)))
      `(labels ((,next-fname (&key ,@state-vars)
                  (labels ((self () ,@next-body)) #'self)))
         (defun ,constructor-name ,constructor-params
           ,docstring
           (macrolet
               ((init-state (&rest argspecs)
                  (list 'apply '#',next-fname
                        (apply #'append
                               '(list )
                               (mapcar (lambda (aspec)
                                         (if (symbolp aspec)
                                             (list (alx:make-keyword aspec) aspec)
                                             (destructuring-bind (aname adef) aspec
                                               (list (alx:make-keyword aname) adef))))
                                       argspecs)))))
             ,@constructor-body))))))

;; macroexpand:
(labels ((#:next-fname138 (&key base-iter pred been-false) (labels ((self nil (if been-false (next base-iter) (multiple-value-bind (item base-alive) (next base-iter) (if base-alive (if (funcall pred item) (self) (progn (setf been-false t) (values item t))) (values nil nil)))))) (function self)))) (defun dropwhile (predicate iterable) "Drops all elements of `base-iter` until `pred` first returns false, then yields all further elements ``` (dropwhile (lambda (x) (< 3 x) (count))) ;; 3, 4, 5, etc ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname138)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (pred predicate) (base-iter (make-iterator iterable))))))


[User]
Generate a defmacro form that transforms code like this:
(check-cursor-attached cluffer:end-of-buffer-p (cursor))

Pattern to recognize: Macro call that should be transformed by check-cursor-attached

(check-cursor-attached cluffer:end-of-buffer-p (cursor))

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

;; macroexpand:
(defmethod cluffer:end-of-buffer-p :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defdata maybe (just t) nothing)

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

(defdata maybe (just t) nothing)

[Assistant]
(defmacro defdata (adt-name &body constructors)
  "Define a new ADT. ADT-name has the following grammar:

ADT-NAME := <symbol>
          | (<symbol> <options>*)

There is no difference between specifying it as a symbol or as a
singleton list. There are two possible options, specified as a
property list:

    * :MUTABLE {T, NIL} (default: NIL): Specifies whether the fields
      of the type are mutable, allowing the use of SET-DATA.

    * :INCLUDE <adt-type>: Specifies whether another defined ADT
      should be inherited.

Constructors is a list of clauses with the following grammar:

<clause> := <symbol>
          | (<symbol> <type-specifier>*)

Each clause defines a constructor for the ADT. Nullary constructors
will define constants and all other constructors will define
functions."
  ;; Do some extreme sanity checking.
  (assert
   (or
    ;; Must be a symbol, or...
    (symbolp adt-name)
    (and
     ;; a list that is...
     (listp adt-name)
     ;; non-empty
     (not (null adt-name))
     ;; whose first element is a symbol (the name of the adt)
     (symbolp (first adt-name))
     ;; and the rest is a property list
     (property-list-p (rest adt-name))))
   (adt-name)
   "ADT-NAME must either be a symbol, a singleton list with the ADT ~
      name as a symbol, or a list of two elements with the ADT name ~
      and :MUTABLE respectively. Given ~S."
   adt-name)
  (let ((valid-options (list ':mutable ':include)))
    (when (and (listp adt-name) (= (mod (length (rest adt-name)) 2) 0))
      (loop for opt in (rest adt-name) by #'cddr do
	   (when (not (member opt valid-options))
	     (error "Option ~A is not valid, valid options are member of ~A." opt valid-options)))))

  (let ((adt-name (ensure-car adt-name))
        (mutable? (and (listp adt-name)
                       (getf (rest adt-name) ':mutable)
                       t))
        (include (or (and (listp adt-name)
                          (getf (rest adt-name) ':include))
                     'algebraic-data-type))
        (object (gensym "OBJECT-"))
        (stream (gensym "STREAM-"))
        (depth (gensym "DEPTH-"))
        (env (gensym "ENVIRONMENT-"))
        (documentation
          (when (stringp (car constructors))
            (pop constructors))))

    ;; Sanity check that INCLUDE is a proper algebraic data type.
    (assert (algebraic-data-type-p include)
            ()
            "When defining the algebraic data type ~S, the :INCLUDE option ~
             was specified with ~S, which is not another algebraic data ~
             type."
            adt-name
            include)

    ;; Add constructors and their arity to the database.
    (flet ((constructor-and-arity (ctor)
             (if (listp ctor)
                 (list (first ctor) (length (rest ctor)))
                 (list ctor 0))))
      (set-constructors adt-name (append (get-constructors include)
                                         (mapcar #'constructor-and-arity constructors))))

    (flet ((make-printer (name &optional (nfields 0))
             "Make a printer function for the structs."
             `(lambda (,object ,stream ,depth)
                (declare (ignore ,depth)
                         (ignorable ,object))
                ;; We don't check *PRINT-READABLY* because these can
                ;; be readably printed always, provided the arguments
                ;; can be printed readably.
                ;;
                ;; However, we do respect a convenience option
                ;; *PRINT-ADT-READABLY* in case someone finds the
                ;; printing of the #. to be annoying.
                (when *print-adt-readably*
                  (write-string "#." ,stream))
                ,(when (plusp nfields)
                   `(write-char #\( ,stream))
                (prin1 ',name ,stream)
                ,@(when (plusp nfields)
                    (loop :for i :below nfields
                          :append (list
                                   `(write-char #\Space ,stream)
                                   `(prin1 (,(field name i) ,object)
                                           ,stream))))
                ,(when (plusp nfields)
                   `(write-char #\) ,stream)))))
      ;; Define everything.
      (let ((component-documentation
             ;; Force the adt-name symbol to print with a package
             ;; prefix
             (let ((*package* (find-package :keyword)))
               (format nil "A component of ADT ~S" adt-name))))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
           ;; Define the data type.
           (defstruct (,adt-name (:constructor nil)
                                 (:copier nil)
                                 (:predicate nil)
                                 (:include ,include))
             ,@(unsplice documentation))

           ;; Define each of the field constructors.
           ,@(loop :for ctor :in (unwrap-singletons constructors)
                   :collect
                   (etypecase ctor
                     ;; Nullary constructor
                     (symbol `(progn
                                (eval-when (:compile-toplevel :load-toplevel :execute)
                                  (defstruct
                                      (,ctor
                                       (:include ,adt-name)
                                       (:constructor ,(internal ctor))
                                       (:copier nil)
                                       (:predicate nil)
                                       (:print-function ,(make-printer ctor)))
                                    ,component-documentation))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor))
                                (defmethod make-load-form ((,object ,ctor) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names nil
                                                               :environment ,env))
                                (define-constant ,ctor (,(internal ctor))
                                  ,component-documentation)
                                (fmakunbound ',(internal ctor))))

                     ;; N-ary constructors
                     (list (let* ((ctor-name (first ctor))
                                  (field-types (rest ctor))
                                  (field-names (gen-names (length field-types))))
                             `(progn
                                (defstruct (,ctor-name
                                            (:include ,adt-name)
                                            (:constructor ,ctor-name (,@field-names))
                                            (:conc-name ,ctor-name)
                                            (:copier nil)
                                            (:predicate nil)
                                            (:print-function
                                             ,(make-printer ctor-name
                                                            (length field-names))))
                                  ,component-documentation
                                  ,@(mapcar (lambda (name type)
                                              `(,name (error "Unspecified field.")
                                                      :type ,type
                                                      ,@(if mutable?
                                                            nil
                                                            '(:read-only t))))
                                     field-names
                                     field-types))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor-name))
                                (defmethod make-load-form ((,object ,ctor-name) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names ',field-names
                                                               :environment ,env)))))))
           ;; Return the type name
           ',adt-name)))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (maybe (:constructor nil) (:copier nil) (:predicate nil) (:include algebraic-data-type))) (progn (defstruct (just (:include maybe) (:constructor just (%0)) (:conc-name just) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-133 #:stream-134 #:depth-135) (declare (ignore #:depth-135) (ignorable #:object-133)) (when *print-adt-readably* (write-string "#." #:stream-134)) (write-char #\LEFT_PARENTHESIS #:stream-134) (prin1 (quote just) #:stream-134) (write-char #\Space #:stream-134) (prin1 (just%0 #:object-133) #:stream-134) (write-char #\RIGHT_PARENTHESIS #:stream-134)))) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE") (%0 (error "Unspecified field.") :type t :read-only t)) (declaim (sb-ext:freeze-type just)) (defmethod make-load-form ((#:object-133 just) &optional #:environment-136) (make-load-form-saving-slots #:object-133 :slot-names (quote (%0)) :environment #:environment-136))) (progn (eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (nothing (:include maybe) (:constructor %nothing) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-133 #:stream-134 #:depth-135) (declare (ignore #:depth-135) (ignorable #:object-133)) (when *print-adt-readably* (write-string "#." #:stream-134)) nil (prin1 (quote nothing) #:stream-134) nil))) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE"))) (declaim (sb-ext:freeze-type nothing)) (defmethod make-load-form ((#:object-133 nothing) &optional #:environment-136) (make-load-form-saving-slots #:object-133 :slot-names nil :environment #:environment-136)) (define-constant nothing (%nothing) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::MAYBE")) (fmakunbound (quote %nothing))) (quote maybe))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors-read-only a c e) obj)) (setf a :a c :c) (ensure-same (list a c e) '(:a :c 5) :test 'equal) (ensure-same (list (e obj) (c obj) (a obj)) '(5 3 1) :test 'equal))

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

(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors-read-only a c e) obj)) (setf a :a c :c) (ensure-same (list a c e) '(:a :c 5) :test 'equal) (ensure-same (list (e obj) (c obj) (a obj)) '(5 3 1) :test 'equal))

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

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

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

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

;; macroexpand:
(let* ((obj (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (#:|values-174| obj) (a (a #:|values-174|)) (c (c #:|values-174|)) (e (e #:|values-174|))) (declare (ignorable #:|values-174|)) (progn (setf a :a c :c) (ensure-same (list a c e) (quote (:a :c 5)) :test (quote equal)) (ensure-same (list (e obj) (c obj) (a obj)) (quote (5 3 1)) :test (quote equal))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(signal-reader-error "Expected } after Unicode character name")

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

(signal-reader-error "Expected } after Unicode character name")

[Assistant]
(defmacro signal-reader-error (format-control &rest format-arguments)
  "Like ERROR but signals a SIMPLE-READER-ERROR for the stream
*STREAM*."
  `(error 'simple-reader-error
          :stream *stream*
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

;; macroexpand:
(error (quote simple-reader-error) :stream *stream* :format-control "Expected } after Unicode character name" :format-arguments (list))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(fail (warn "An expected warning.") warning)

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

(fail (warn "An expected warning.") warning)

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(def-iter iterator-combinations (indices pool stopped r n) (combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))

Issue: Macro call that should be transformed by def-iter

(def-iter iterator-combinations (indices pool stopped r n) (combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1))))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))

[Assistant]
(defmacro def-iter (name state-vars (constructor-name constructor-params &body constructor-body)
                    &body next-body)
  "An anaphoric convenience macro which can be re-implemented to change how iterators are
  structured. Exposes the local `init-state` macro within `constructor-body`

  If you don't want to-use this macro (which I totally understand) just write constructors for your
  iterators returning 0-argument closures representing the `next` function and you'll be fine. This
  macro just helped me get through a lot of waffling during development

  Parameters
  ----------
  `name` is a synbol naming the iterator's backing state. However it's actually
  ignored, since PICL doesn't currently expose iterators' backing state

  `state-vars` is a list of symbols naming the iterator's state variables.

  The `constructor-name/params/body` will be `defun`'d to create the user-facing constructor
  function. In `constructor-body`, the return value should be an iterator or a call to local
  `init-state` macro

  `next-body` The definition of the `next` function for this iterator, which will be run in a
   lexical environment consisting of the state vars

  Both `constructor-body` and `next-body` are defined in the lexical environment of the `def-iter`
  form, and as such can access any lexical bindings not shadowed by the `constructor-params` and
  `state-vars` respectively

  The local `init-state` macro.
  ----------------------------
  The arguments to `init-state` should be of the form `(statevar-symbol value-form)`or
  `statevar-symbol`. In the first case, the value of `value-form` will be used to initialize the
  state variable named by `symbol`. In the second case, `statevar-symbol` is also used as the
  corresponding `value-form`

  Example
  -------
  What follows is a sample implementation of the `count` iterator using this macro
  ```
  (def-iter ignored-backing-name (curr-val step)
    (count (start step)
      (init-state (curr-val start) step))
    (prog1 curr-val (incf curr-val step))))
  ````"

  (declare (ignore name))
  (alexandria:with-gensyms (next-fname)
    (let ((docstring "Function had no docstring, so this one was inserted"))
      (when (and (cdr constructor-body) (stringp (car constructor-body)))
        (setf docstring (car constructor-body)
              constructor-body (cdr constructor-body)))
      `(labels ((,next-fname (&key ,@state-vars)
                  (labels ((self () ,@next-body)) #'self)))
         (defun ,constructor-name ,constructor-params
           ,docstring
           (macrolet
               ((init-state (&rest argspecs)
                  (list 'apply '#',next-fname
                        (apply #'append
                               '(list )
                               (mapcar (lambda (aspec)
                                         (if (symbolp aspec)
                                             (list (alx:make-keyword aspec) aspec)
                                             (destructuring-bind (aname adef) aspec
                                               (list (alx:make-keyword aname) adef))))
                                       argspecs)))))
             ,@constructor-body))))))

;; macroexpand:
(labels ((#:next-fname128 (&key indices pool stopped r n) (labels ((self nil (if stopped (values nil nil) (multiple-value-prog1 (loop with ret-vec = (make-array r) for i below r do (setf (aref ret-vec i) (aref pool (aref indices i))) finally (return (values ret-vec t))) (loop for i from (1- r) downto 0 when (/= (aref indices i) (+ i n (- r))) do (incf (aref indices i)) (loop for j from (1+ i) to (1- r) do (setf (aref indices j) (1+ (aref indices (1- j))))) (return) finally (setf stopped t)))))) (function self)))) (defun combinations (r iterable) "r-combinations of input iterable, returned as vectors in lexicographic order. ``` (combinations 2 '(1 2 3)) ;; #(1 2), #(1 3), #(2 3) ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname128)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (let ((ivec (iter-to-vec iterable))) (if (> r (length ivec)) (empty-iterator) (init-state r (n (length ivec)) (pool ivec) (indices (iter-to-vec (range 0 r 1)))))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(assert-values ("changed foo = 1") (foo 1) (foo+1 2) (bar 2) (bar-1 1))

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

(assert-values ("changed foo = 1") (foo 1) (foo+1 2) (bar 2) (bar-1 1))

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

;; macroexpand:
(progn (trc "changed foo = 1") (assert (eql (value foo) 1)) (assert (eql (value foo+1) 2)) (assert (eql (value bar) 2)) (assert (eql (value bar-1) 1)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(when (or (typep (node-slot expression) 'function-call) (typep (node-slot expression) 'infix-expression) (typep (node-slot expression) 'prefix-expression) (typep (node-slot expression) 'postfix-expression) (typep (node-slot expression) 'empty) (node-slot force-semicolon)) (format stream ";"))

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

(when (or (typep (node-slot expression) 'function-call) (typep (node-slot expression) 'infix-expression) (typep (node-slot expression) 'prefix-expression) (typep (node-slot expression) 'postfix-expression) (typep (node-slot expression) 'empty) (node-slot force-semicolon)) (format stream ";"))

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

;; macroexpand:
(if (or (typep (node-slot expression) (quote function-call)) (typep (node-slot expression) (quote infix-expression)) (typep (node-slot expression) (quote prefix-expression)) (typep (node-slot expression) (quote postfix-expression)) (typep (node-slot expression) (quote empty)) (node-slot force-semicolon)) (format stream ";"))


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

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

(continue-whopper nil :key nil)

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

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


[User]
Generate a defmacro form that transforms code like this:
(draw scene (:rect :x 30 :y 30 :width 400 :height 150) :fill "rgb(230,230,230)" :stroke "black")

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

(draw scene (:rect :x 30 :y 30 :width 400 :height 150) :fill "rgb(230,230,230)" :stroke "black")

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

;; macroexpand:
(let ((#:g164 (funcall (function make-svg-element) :rect (append (list :x 30 :y 30 :width 400 :height 150) (list :fill "rgb(230,230,230)" :stroke "black"))))) (add-element scene #:g164) #:g164)


[User]
Write a Common Lisp macro to handle this code pattern:
(letrec* (x) x)

Problem: Macro call that should be transformed by letrec*

(letrec* (x) x)

[Assistant]
(defmacro letrec* ((&rest bindings) &body body)
  "Like LETREC, but the bindings are evaluated in order.
See Waddell et al., *Fixing Letrec* for motivation.

Cf. `fbindrec*'."
  `(letrec-with setq ,bindings
     ,@body))

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


[User]
Define a macro that eliminates this repetitive pattern:
(alist-bind (name type) form (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) `(define-foreign-extern ',sym ,name ',@(parse-type type (aval :tag type)))))

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

(alist-bind (name type) form (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) `(define-foreign-extern ',sym ,name ',@(parse-type type (aval :tag type)))))

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

;; macroexpand:
(let ((#:alist246 form)) (let ((name (aval :name #:alist246)) (type (aval :type #:alist246))) (let ((sym (foreign-type-symbol name :cextern *package*))) (push sym *foreign-extern-list*) (sb-int:quasiquote (define-foreign-extern (quote #S(sb-impl::comma :expr sym :kind 0)) #S(sb-impl::comma :expr name :kind 0) (quote #S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2)))))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-simple-type-map variable cl:variable)

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(undefmessage 'some-name)

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

(undefmessage 'some-name)

[Assistant]
(defmacro UNDEFMESSAGE ...)

;; macroexpand:
(fmakunbound ''some-name)


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

Issue: Macro call that should be transformed by ->

(->
  'some-name)

[Assistant]
(defmacro -> ...)

;; macroexpand:
'some-name


[User]
Write a Common Lisp macro to handle this code pattern:
(defsynonym multiplying :mult)

Problem: Macro call that should be transformed by defsynonym

(defsynonym multiplying :mult)

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

;; macroexpand:
(eval-always (setf (get (quote multiplying) (quote synonym)) (quote :mult)))


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

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

(next-in nil :key nil)

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

;; macroexpand:
(do-next-in nil #'(lambda () :key nil))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-table-name nil (yield obj))

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

(with-table-name nil (yield obj))

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

;; macroexpand:
(let ((*table-name-scope* nil)) (yield obj))


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

Issue: Macro call that should be transformed by DECF

(decf nil nil)

[Assistant]
(defmacro DECF ...)

;; macroexpand:
(setq nil (sb-impl::xsubtract nil nil))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(read-char*)

What needs to change: Macro call that should be transformed by read-char*

(read-char*)

[Assistant]
(defmacro read-char* ()
  "Convenience macro because we always read from the same string with
the same arguments."
  `(read-char *stream* t nil t))

;; macroexpand:
(read-char *stream* t nil t)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause (sum expr &optional into var result-type (type 'number)) "Sum into a variable" (return-reduction-code :identity 0 :operation '+ :expression expr :test nil :variable var :type type :accum-kind :increment))

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

(defclause (sum expr &optional into var result-type (type 'number)) "Sum into a variable" (return-reduction-code :identity 0 :operation '+ :expression expr :test nil :variable var :type type :accum-kind :increment))

[Assistant]
(defmacro defclause (clause-template &body body)
  (define-clause 'defun clause-template body nil))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-sum-10 (&key ((:sum expr)) ((:into var)) ((:result-type type) (quote number))) "Sum into a variable" (return-reduction-code :identity 0 :operation (quote +) :expression expr :test nil :variable var :type type :accum-kind :increment)) (install-clause-info (quote (sum)) (quote (sum &optional :into :result-type)) (quote clause-sum-10) "Sum into a variable" nil) (quote (sum expr &optional into var result-type (type (quote number)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form 'multiple-value-call-nondeterministic) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (rest form)))) (funcall map-function form 'multiple-value-call-nondeterministic)))

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

(defun-compile-time walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form 'multiple-value-call-nondeterministic) (reduce reduce-function (mapcar #'(lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment)) (rest form)))) (funcall map-function form 'multiple-value-call-nondeterministic)))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun walk-multiple-value-call-nondeterministic (map-function reduce-function screamer? partial? nested? form environment) (unless (null (rest (last form))) (error "Improper MULTIPLE-VALUE-CALL-NONDETERMINISTIC: ~S" form)) (unless (>= (length form) 2) (error "MULTIPLE-VALUE-CALL-NONDETERMINISTIC must have at least one ~ argument, a FUNCTION: ~S" form)) (if reduce-function (funcall reduce-function (funcall map-function form (quote multiple-value-call-nondeterministic)) (reduce reduce-function (mapcar (function (lambda (subform) (walk map-function reduce-function screamer? partial? nested? subform environment))) (rest form)))) (funcall map-function form (quote multiple-value-call-nondeterministic)))) (eval-when (:compile-toplevel) (compile (quote walk-multiple-value-call-nondeterministic))))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-table node hash depth (bitmap array bits index hit) (if hit (%hamt-lookup (aref array index) key hash (1+ depth) test) (values nil nil)))

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

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

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-match node) (multiple-value-bind (new-node new-changed?) (maybe-simplify-match node) (when new-changed? (setf changed? t) new-node)))

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

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

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

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


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

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

(do-for nil
  nil)

[Assistant]
(defmacro DO-FOR ...)

;; macroexpand:
(block nil (lc ((block nil (tagbody (return (progn nil))))) progn))


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

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

(-> :three () (increment))

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

;; macroexpand:
(atomically :three nil (increment))


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

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

(set-handler nil :key nil)

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

;; macroexpand:
(let ((key :key) (function nil))
  (let ((found (assoc key nil :test #'equal)))
    (if found
        (setf (cdr found) function)
        (prog1 function (push (cons key function) nil)))))


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

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defstore example (&key (a 0) (b 0) (c (the integer (init-c a b)))))

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

(defstore example (&key (a 0) (b 0) (c (the integer (init-c a b)))))

[Assistant]
(defmacro defstore (store-name store-lambda-list &body body &environment env)
  (let* ((store-class-name (second (find :store-class body :key #'first)))
         (store-class (etypecase store-class-name
                        (null (find-class 'standard-store))
                        (symbol (find-class store-class-name))))
         (form (apply #'defstore-using-class store-class store-name store-lambda-list
                      :environment env
                      (mapcan #'(lambda (item)
                                  (cond ((eql (first item) :store-class)
                                         `(:store-class ',store-class-name))
                                        ((and (member (first item) '(:documentation :specialization-class)))
                                         (if (= 2 (length item))
                                             item
                                             (error "Invalid store definition option: ~W." item)))
                                        (t
                                         (list (first item) (rest item)))))
                              body))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,form)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (defun a-init-function152 (a #:a?163 b #:b?164) (declare (ignorable a #:a?163 b #:b?164)) (the integer (init-c a b))) (ensure-store (quote example) (quote (&key (a 0 #:a?163) (b 0 #:b?164) (c (the integer (a-init-function152 a #:a?163 b #:b?164)) #:c?165))))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn (format nil "SHOW CREATE VIEW `~A`" table-name)) (let ((results (dbi:execute query))) (getf (first (dbi:fetch-all results :format :plist)) :|Create View|)))

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

(with-prepared-query query (conn (format nil "SHOW CREATE VIEW `~A`" table-name)) (let ((results (dbi:execute query))) (getf (first (dbi:fetch-all results :format :plist)) :|Create View|)))

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

;; macroexpand:
(call-with-prepared-query conn (format nil "SHOW CREATE VIEW `~A`" table-name) (lambda (query) (let ((results (dbi.driver:execute query))) (getf (first (dbi.driver:fetch-all results :format :plist)) :|Create View|))) :use-prepare-cached nil)


[User]
Define a macro that eliminates this repetitive pattern:
(when else-body `(make-simple-block ,else-body))

Issue: Macro call that should be transformed by when

(when else-body `(make-simple-block ,else-body))

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

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


[User]
Generate a defmacro form that transforms code like this:
(define-case-aware-find-symbol find-pragma-name #:with-c-syntax.pragma-name)

Pattern to recognize: Macro call that should be transformed by define-case-aware-find-symbol

(define-case-aware-find-symbol find-pragma-name #:with-c-syntax.pragma-name)

[Assistant]
(defmacro define-case-aware-find-symbol
    (finder-function-name package-name
     &key (upcased-package-name (format nil "~A.~A" (string package-name) '#:UPCASED))
       (docstring
        (format nil "Find a symbol in `~A' package having a same NAME. If not found, returns `nil'."
                package-name)))
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defpackage ,upcased-package-name
       (:use)
       (:intern
        ,@(loop for sym being the external-symbol of package-name
                collect (string-upcase (symbol-name sym)))))
     ,@(loop for sym being the external-symbol of package-name
             for upcased = (string-upcase (symbol-name sym))
             collect `(setf (symbol-value (find-symbol ,upcased ',upcased-package-name))
                            ',sym))
     (defun ,finder-function-name (string &optional (readtable-case (readtable-case *readtable*)))
       ,@(if docstring `(,docstring))
       (ecase readtable-case
         ((:upcase :invert)
          (if-let ((up-sym (find-symbol string ',upcased-package-name)))
            (symbol-value up-sym)))
         ((:downcase :preserve)
          (find-symbol string ',package-name))))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED") (:use) (:intern #A((4) base-char . "STDC") #A((4) base-char . "ONCE") #A((13) base-char . "WITH_C_SYNTAX"))) (setf (symbol-value (find-symbol #A((4) base-char . "STDC") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:stdc)) (setf (symbol-value (find-symbol #A((4) base-char . "ONCE") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:|once|)) (setf (symbol-value (find-symbol #A((13) base-char . "WITH_C_SYNTAX") (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED")))) (quote with-c-syntax.pragma-name:with_c_syntax)) (defun find-pragma-name (string &optional (readtable-case (readtable-case *readtable*))) #A((101) base-char . "Find a symbol in `WITH-C-SYNTAX.PRAGMA-NAME' package having a same NAME. If not found, returns `nil'.") (ecase readtable-case ((:upcase :invert) (if-let ((up-sym (find-symbol string (quote #A((33) base-char . "WITH-C-SYNTAX.PRAGMA-NAME.UPCASED"))))) (symbol-value up-sym))) ((:downcase :preserve) (find-symbol string (quote #:with-c-syntax.pragma-name))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(do-files (file (app-path "themes/") "tmpl") (compile-template :common-lisp-backend file))

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

(do-files (file (app-path "themes/") "tmpl") (compile-template :common-lisp-backend file))

[Assistant]
(defmacro do-files ((var path &optional extension) &body body)
  "For each file under PATH, run BODY. If EXTENSION is provided, only run
BODY on files that match the given extension."
  (alexandria:with-gensyms (extension-p)
    `(flet ((,extension-p (file)
              (string= (pathname-type file) ,extension)))
       (cl-fad:walk-directory ,path (lambda (,var) ,@body)
                              :follow-symlinks nil
                              :test (if ,extension
                                        #',extension-p
                                        (constantly t))))))

;; macroexpand:
(flet ((#:extension-p289 (file) (string= (pathname-type file) "tmpl"))) (cl-fad:walk-directory (app-path "themes/") (lambda (file) (compile-template :common-lisp-backend file)) :follow-symlinks nil :test (if "tmpl" (function #:extension-p289) (constantly t))))


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

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

(true 5)

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

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (true 5)) :value-form (quote 5) :body (lambda nil 5) :expected (quote t) :comparison (quote geq)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause (multiply expr &optional into var result-type (type 'number)) "Multiply into a variable" (return-reduction-code :identity 1 :operation '* :expression expr :test nil :variable var :type type :accum-kind :increment))

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

(defclause (multiply expr &optional into var result-type (type 'number)) "Multiply into a variable" (return-reduction-code :identity 1 :operation '* :expression expr :test nil :variable var :type type :accum-kind :increment))

[Assistant]
(defmacro defclause (clause-template &body body)
  (define-clause 'defun clause-template body nil))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-multiply-11 (&key ((:multiply expr)) ((:into var)) ((:result-type type) (quote number))) "Multiply into a variable" (return-reduction-code :identity 1 :operation (quote *) :expression expr :test nil :variable var :type type :accum-kind :increment)) (install-clause-info (quote (multiply)) (quote (multiply &optional :into :result-type)) (quote clause-multiply-11) "Multiply into a variable" nil) (quote (multiply expr &optional into var result-type (type (quote number)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-wcs-math-error-handling (ret (atanh x)) (check-wcs-math-result))

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

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

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

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


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

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

(->*
  nil
  :key
  nil)

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

;; macroexpand:
(let* ((#:var194 nil) (#:var195 (nil #:var194)) (#:var196 (:key #:var195)))
  #:var196)


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

Problem: Macro call that should be transformed by LET+

(let+ nil)

[Assistant]
(defmacro LET+ ...)

;; macroexpand:
(locally)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(fmap #'nreverse (recurse (list res) next))

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

(fmap #'nreverse (recurse (list res) next))

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

;; macroexpand:
(multiple-value-bind (res next) (recurse (list res) next) (if (failure? res) (fail next) (values (funcall (function nreverse) res) next)))


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

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

(some-> nil (progn))

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

;; macroexpand:
(let* ((#:|some127| nil) (#:|some127| (when #:|some127| (progn #:|some127|))))
  #:|some127|)


[User]
Generate a defmacro form that transforms code like this:
(setypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))

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

(setypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))

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

;; macroexpand:
(symbolic etypecase (car x) (symbol (setf it :no)) (string (setf it "OK")) (integer (setf it :noon)))


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

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

(iterate
  nil
  (progn))

[Assistant]
(defmacro ITERATE ...)

;; macroexpand:
(iter
  nil
  (progn))


[User]
Define a macro that eliminates this repetitive pattern:
(sif 1 (aif it it))

Issue: Macro call that should be transformed by sif

(sif 1 (aif it it))

[Assistant]
(defmacro sif (test then &optional else)
  "Like IF, except binds the test form to IT (via SYMBOL-MACROLET) for
the scope of the then and else expressions. IT can be set with SETF"
  `(symbolic if ,test ,then ,else))

;; macroexpand:
(symbolic if 1 (aif it it) nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(lambda-match0 ((list* 'guard1 _) t))

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

(lambda-match0 ((list* 'guard1 _) t))

[Assistant]
(defmacro lambda-match0 (&body clauses)
  (alexandria:with-gensyms (arg)
    `(lambda (,arg)
       (match0 ,arg
         ,@clauses))))

;; macroexpand:
(lambda (#:arg164) (match0 #:arg164 ((list* (quote guard1) _) t)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-transaction *db* (commit *db*) (setf value :foo))

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

(with-transaction *db* (commit *db*) (setf value :foo))

[Assistant]
(defmacro with-transaction (conn &body body)
  "Start a transaction and commit at the end of this block. If the evaluation `body` is interrupted, the transaction is rolled back automatically."
  (let ((conn-var (gensym "CONN-VAR")))
    `(let ((,conn-var ,conn))
       (if (in-transaction ,conn-var)
           (with-savepoint ,conn-var ,@body)
           (%with-transaction ,conn-var ,@body)))))

;; macroexpand:
(let ((#:conn-var161 *db*)) (if (in-transaction #:conn-var161) (with-savepoint #:conn-var161 (commit *db*) (setf value :foo)) (%with-transaction #:conn-var161 (commit *db*) (setf value :foo))))


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

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

(maybe-once-only nil
  :key
  nil)

[Assistant]
(defmacro MAYBE-ONCE-ONLY ...)

;; macroexpand:
(let* ((#:g184 nil))
  `(let* ,(nreverse #:g184)
     ,:key
     ,nil))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms))

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

(defclause finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms))

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

;; macroexpand:
(progn (defmacro finally (&rest forms) "Evaluates <form> after the last iteration, before returning a value." (mapcar (lambda (form) (make-finalization :form form)) forms)) (pushnew (quote finally) *clauses*))


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

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

(sum-of nil
  :key
  nil)

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

;; macroexpand:
(lc (nil :key nil) sum)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(deferror "42701" duplicate-column syntax-error-or-access-violation)

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

(deferror "42701" duplicate-column syntax-error-or-access-violation)

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

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


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

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

(cond-> nil (progn))

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

;; macroexpand:
(let* ((#:|cond132| nil)
       (#:|cond132|
        (if progn
            #:|cond132|
            #:|cond132|)))
  #:|cond132|)


[User]
Write a Common Lisp macro to handle this code pattern:
(in-compile-time nil)

Problem: Macro call that should be transformed by IN-COMPILE-TIME

(in-compile-time nil)

[Assistant]
(defmacro IN-COMPILE-TIME ...)

;; macroexpand:
(macrolet ((#:macro141 (&environment ())
             ))
  (#:macro141))


[User]
Write a Common Lisp macro to handle this code pattern:
(when (not (or (eql (top-info) 'typedef) (eql (top-info) 'decl))) (format stream ";"))

Problem: Macro call that should be transformed by when

(when (not (or (eql (top-info) 'typedef) (eql (top-info) 'decl))) (format stream ";"))

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

;; macroexpand:
(if (not (or (eql (top-info) (quote typedef)) (eql (top-info) (quote decl)))) (format stream ";"))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(def-neo4j-fun get-node-properties (node-id) :get (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (200 (decode-neo4j-json-output body)) (204 nil) (404 (error 'node-not-found-error :uri uri))))

What needs to change: Macro call that should be transformed by def-neo4j-fun

(def-neo4j-fun get-node-properties (node-id) :get (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (200 (decode-neo4j-json-output body)) (204 nil) (404 (error 'node-not-found-error :uri uri))))

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

;; macroexpand:
(progn (defun get-node-properties (&key node-id) (let ((uri (format nil "node/~A/properties" node-id)) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 204 (lambda (body uri json) nil)) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


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

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

(lambda ())

[Assistant]
(defmacro LAMBDA ...)

;; macroexpand:
#'(lambda ())


[User]
Create a Common Lisp macro for the following transformation. Before code:
(gen-lambda-with-sticky-stop () (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply #'values (nreverse tmp))))

What needs to change: Macro call that should be transformed by gen-lambda-with-sticky-stop

(gen-lambda-with-sticky-stop () (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply #'values (nreverse tmp))))

[Assistant]
(defmacro gen-lambda-with-sticky-stop (&rest rest)
  `(make-instance
    'basic-generator
    :function (sticky-stop-lambda ,@rest)))

;; macroexpand:
(make-instance (quote basic-generator) :function (sticky-stop-lambda nil (loop for g in generators for v in valfuncs do (let ((data (multiple-value-list (funcall v g)))) (if (car data) (progn (push (car data) sigs) (push (cdr data) stor)) (sticky-stop)))) (when (= 0 (length (remove-if (lambda (x) (eq x :filled)) sigs))) (sticky-stop)) (let ((tmp stor)) (setf stor nil) (setf sigs nil) (apply (function values) (nreverse tmp)))))


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

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

(send nil :key nil)

[Assistant]
(defmacro SEND ...)

;; macroexpand:
(send (slot-value nil ':key) nil)


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

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error* (car this-last-pos) "Quantifier '~A' not allowed." (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer)))

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

(signal-syntax-error* (car this-last-pos) "Quantifier '~A' not allowed." (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer)))

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

;; macroexpand:
(error (quote ppcre-syntax-error) :pos (car this-last-pos) :format-control "Quantifier '~A' not allowed." :format-arguments (list (subseq (lexer-str lexer) (car this-last-pos) (lexer-pos lexer))))


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

Pattern to recognize: Macro call that should be transformed by WITHOUT-SYMBOL-ACCESS

(without-symbol-access)

[Assistant]
(defmacro WITHOUT-SYMBOL-ACCESS ...)

;; macroexpand:
(let ((*symbol-access* nil)))


[User]
Write a Common Lisp macro to handle this code pattern:
(when (and (not (eql (top-info) 'decl)) (> (length (slot-value (node-slot members) 'nodes)) 3)) (push-sign 'enum-break))

Problem: Macro call that should be transformed by when

(when (and (not (eql (top-info) 'decl)) (> (length (slot-value (node-slot members) 'nodes)) 3)) (push-sign 'enum-break))

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

;; macroexpand:
(if (and (not (eql (top-info) (quote decl))) (> (length (slot-value (node-slot members) (quote nodes))) 3)) (push-sign (quote enum-break)))