Ok, the patches are now in git/CVS. Using the code below, compiled, these are the benchmark figures of FPRINT/PRETTY for different commits. The greatest improvement was the use of special dispatch functions.

I have been doing some intensive checks of the functions, but please, should you find any problem, report it ASAP and I will try to fix it. 

Now, back to the cave for some more optimizations...

Starting point
;;; Loading "/Users/jjgarcia/tmp/foo.fas"
real time : 3.534 secs
run time  : 3.445 secs
gc count  : 2 times
consed    : 20413056 bytes

SETF functions stored in compiled code
;;; Loading "/Users/jjgarcia/tmp/foo.fas"
real time : 3.449 secs
run time  : 3.250 secs
gc count  : 2 times
consed    : 20410992 bytes

New dispatch for slot accessors
;;; Loading "/Users/jjgarcia/tmp/foo.fas"
real time : 1.873 secs
run time  : 1.836 secs
gc count  : 2 times
consed    : 20410896 bytes

(defvar *a* 'nil)

(defparameter +fread-temporary-pathname+ "/tmp/fprint.tst")

(defvar *fprint-test-atoms*
  '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67
    mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12
    wxyzab23 xyzabc34 123456ab 234567bc 345678cd
    456789de 567890ef 678901fg 789012gh 890123hi))

(defun fprint-init-aux (m n atoms)
  (declare (fixnum m n))
  (cond ((zerop m) (pop atoms))
(t (do ((i n (- i 2))
(a ()))
      ((< i 1) a)
    (push (pop atoms) a)
    (push (fprint-init-aux (1- m) n atoms) a)))))

(defun fprint-init (m n atoms)
  (let ((atoms (subst () () atoms)))
    (do ((a atoms (cdr a)))
((null (cdr a)) (rplacd a atoms)))
    (fprint-init-aux m n atoms)))

(defvar *fprint-test-pattern* (fprint-init 6. 6. *fprint-test-atoms*))

(defun fprint/pretty ()
  (with-open-file (sink +fread-temporary-pathname+
                        :direction :output
                        :if-exists :supersede)
    (let ((*print-pretty* t)
          (*print-circle* t)
          (*print-escape* t)
          (*print-level* 100)
          (*print-readably* t)
          (*print-base* 10))
      (pprint *fprint-test-pattern* sink))))

(time (dotimes (i 20) (fprint/pretty)))

--
Instituto de Física Fundamental, CSIC
c/ Serrano, 113b, Madrid 28006 (Spain)
http://juanjose.garciaripoll.googlepages.com