anchor.diff:  (defun read-suffix (strm)
     ;; Here, the radix must be 10. The definition of anaphora is the
     ;; basis. Even if *READ-BASE* is not 10.
  -  (do* (clst
  -         (banged? (if (char= (peek-char nil strm t nil t) #\!)
  -                    (read-char strm t nil t)))
  -         (ch (peek-char nil strm t nil t) (peek-char nil strm t nil t)))
  -    ((not (digit-char-p ch))
  -     ;; TODO: what about a1\\1? Should it be an anaphora?
  -     (values (coerce (reverse clst) 'string)
  -             (and (terminating-character-p ch)
  -                  clst
  -                  (or (equal clst '(#\0))
  -                      (char/= (last1 clst) #\0)))
  -             banged?))
  -    (push (read-char strm nil t nil) clst)))
  +  (let (bangs)
  +    (awhile (char= (peek-char nil strm t nil t) #\!)
  +      (push (read-char strm t nil t) bangs))
  +    (do (clst
  +          (ch (peek-char nil strm t nil t) (peek-char nil strm t nil t)))
  +      ((not (digit-char-p ch))
  +       ;; TODO: what about a1\\1? Should it be an anaphora?
  +       (values (coerce (reverse clst) 'string)
  +               (and (terminating-character-p ch)
  +                    clst
  +                    (or (equal clst '(#\0))
  +                        (char/= (last1 clst) #\0)))
  +               (length bangs)))
  +      (push (read-char strm nil t nil) clst))))
   
   (defun intern-anaphora (asuffix)
     (intern (format nil "A~D" asuffix)))
  
positive.code: 
  (defparameter *saved-readtable* nil)
  
  
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defun gen-reader-macro-setup-code (ch local-var shared-var)
      (with-gensyms (strm c suffix anaphora? banged?)
        `(set-macro-character
           ,ch
           (lambda (,strm ,c)
             (declare (ignore ,c))
             (multiple-value-bind (,suffix ,anaphora? ,banged?)
               (read-suffix ,strm)
               (cond ((and ,anaphora? ,banged?)
                      (car (pushnew (intern-anaphora ,suffix) ,shared-var)))
                     (,anaphora?
                       (car (pushnew (intern-anaphora ,suffix) ,local-var)))
                     (t (let ((*readtable* *saved-readtable*))
                          (read (unread-str ,strm ,ch (if ,banged?  "!" "") ,suffix)
                                t nil t))))))
           t))))
  
  
negative.code:          ,(funcall bqreader-fn strm nil))
        (with-anaphora-picking anaphoras shared-anaphoras (#\a #\A)
          (let ((expr (funcall bqreader-fn strm nil)))
            `(lambda ,(sort (union anaphoras (car shared-anaphoras)) #'<=
                            :key #'anaphora-order)
               ,expr))))))
  
  (set-dispatch-macro-character #\# #\` #'|#`-reader|)
  
  (read-from-string "#`(print (list ,a0 ,a1 ,a3))")
  (read-from-string "#`(print (list ,a0 ,a0 ,a3))")
  (read-from-string "#4`(print (list ,a0 a1 a3))")
  (read-from-string "#0`(print (list ,a0 a1 a3))")
  (read-from-string "#`(print (list ,a0 a1 a3))")
  (read-from-string "#`(print (list ,a0 ,a1 ,(progn `(foo ,a0) `(bar ,a2))))")
  (read-from-string "#`(print (list ,a0 ,a1 ,(progn `(foo ,a0) `(bar ,a1))))")
  (read-from-string "#`(print (list ,a0 ,a1 ,(progn #`(foo ,a4) `(bar ,a2))))")
  (read-from-string "#`(print (list ,a0 ,a1 ,(progn #`(foo ,a!4) #`(bar ,a2))))")
  (read-from-string "#`(print (list ,abc ,a1 ,a3))")
  