A setf expander for member-if

setf-member-if.lisp

(defun member-if* (test list &key (key #'identity))
  "Does the same thing as MEMBER-IF."
  (loop :for sublist :on list
        :if (funcall test (funcall key (car sublist)))
          :return sublist))

(define-setf-expander member-if* (test list &key (key #'identity) &environment env)
  (with-gensyms (store-var found-cons test-sym list-sym key-sym sublist prev-sublist)
    (multiple-value-bind (list-vars list-vals list-stores list-set list-get)
        (get-setf-expansion list env)
      (values
       `(,test-sym
         ,@list-vars
         ,list-sym
         ,(car list-stores)
         ,key-sym
         ,found-cons)
       `(,test
         ,@list-vals
         ,list-get
         ,nil
         ,key
         (loop :for ,prev-sublist := :head :then ,sublist
               :for ,sublist :on ,list-sym
               :if (funcall ,test-sym (funcall ,key-sym (car ,sublist)))
                 :return ,prev-sublist))
       `(,store-var)
       `(case ,found-cons
          (:head
           (setf ,(car list-stores) ,store-var)
           ,list-set)
          ((nil)
           ())
          (otherwise
           (setf (cdr ,found-cons) ,store-var)))
       `(case ,found-cons
          (:head ,list-get)
          ((nil) ())
          (otherwise (cdr ,found-cons)))))))