anchor.diff:                        (setf remaining
                               (,(primitive letter) remaining))
                         (error ,(generate-c*r-message function-name
  -                                                    prefix))))))
  +                                                                prefix))))))
         `(defun ,function-name (list)
            (let ((remaining list))
              ,@(loop for letter across (reverse letters)
                      collect (one-iteration letter prefix)
                      collect letter into prefix)
  -           remaining))))))
  +           remaining)))))
   
   (define-c*r-function caar "AA")
   (define-c*r-function cadr "AD")
  
positive.code: (define-c*r-function ninth  "ADDDDDDDD")
  (define-c*r-function tenth   "ADDDDDDDDD")
  
  (defun generate-setf-c*r-message (function-name prefix)
    (if (null prefix)
        (format nil
                "The function (SETF ~a) was given an argument~@
                 that is not a CONS cell"
                function-name)
        (format nil
                "The function (SETF ~a) was given a list whose ~@
                 C~{~a~}R is not a CONS cell"
                function-name
                (reverse (coerce prefix 'list)))))
  
  ;;; FIXME fix the error messsage to signal a particular condition
  (defmacro define-setf-c*r-function (function-name letters)
    (flet ((primitive (letter)
             (if (eql letter #\A) 'car 'cdr)))
      (flet ((one-iteration (letter prefix)
               `(if (consp remaining)
                    (setf remaining
                          (,(primitive letter) remaining))
                    (error ,(generate-setf-c*r-message function-name
                                                       prefix)))))
        `(defun (setf ,function-name) (new-object list)
           (let ((remaining list))
             ,@(append (loop for letter across (reverse (subseq letters 1))
                             collect (one-iteration letter prefix)
                             collect letter into prefix)
                       `(if (consp remaining)
                            (setf (,(primitive (aref letters 0)) remaining)
                                  new-object)
                            (error ,(generate-setf-c*r-message
                                     function-name
                                     (subseq letters 1))))))))))
  
  (defun (setf car) (object cons)
    (rplaca cons object)
    object)
  
  (defun (setf cdr) (object cons)
    (rplacd cons object)
    object)
  
  (define-setf-c*r-function caar "AA")
  (define-setf-c*r-function cadr "AD")
  
negative.code: ;;; is not a list, we would like the error message to mention that,
  ;;; and not for instance that CAR was given a non-list. 
  
  (eval-when (:compile-toplevel :load-toplevel)
    (defun generate-c*r-message (function-name prefix)
      (if (null prefix)
          (format nil
                  "The function ~a was given an argument~@
                 that is neither NIL nor a CONS cell"
                  function-name)
          (format nil
                  "The function ~a was given a list whose ~@
                 C~{~a~}R is neither NIL nor a CONS cell"
                  function-name
                  (reverse prefix)))))
  
  ;;; FIXME fix the error messsage to signal a particular condition
  (defmacro define-c*r-function (function-name letters)
  