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.<div><br></div>

<div>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. </div><div><br></div><div>Now, back to the cave for some more optimizations...<br>

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

<div><br></div><div>SETF functions stored in compiled code</div><div>;;; Loading "/Users/jjgarcia/tmp/foo.fas"</div><div>real time : 3.449 secs</div><div>run time  : 3.250 secs</div><div>gc count  : 2 times</div>

<div>consed    : 20410992 bytes</div><div><br></div><div>New dispatch for slot accessors</div><div>;;; Loading "/Users/jjgarcia/tmp/foo.fas"</div><div>real time : 1.873 secs</div><div>run time  : 1.836 secs</div>

<div>gc count  : 2 times</div><div>consed    : 20410896 bytes</div><div><br></div><div><div>(defvar *a* 'nil)</div><div><br></div><div>(defparameter +fread-temporary-pathname+ "/tmp/fprint.tst")</div><div><br>

</div><div>(defvar *fprint-test-atoms*</div><div>  '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67</div><div>    mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12</div><div>    wxyzab23 xyzabc34 123456ab 234567bc 345678cd</div>

<div>    456789de 567890ef 678901fg 789012gh 890123hi))</div><div><br></div><div>(defun fprint-init-aux (m n atoms)</div><div>  (declare (fixnum m n))</div><div>  (cond ((zerop m) (pop atoms))</div><div><span class="Apple-tab-span" style="white-space:pre">      </span>(t (do ((i n (- i 2))</div>

<div><span class="Apple-tab-span" style="white-space:pre">              </span>(a ()))</div><div><span class="Apple-tab-span" style="white-space:pre">      </span>       ((< i 1) a)</div><div><span class="Apple-tab-span" style="white-space:pre">        </span>     (push (pop atoms) a)</div>

<div><span class="Apple-tab-span" style="white-space:pre">      </span>     (push (fprint-init-aux (1- m) n atoms) a)))))</div><div><br></div><div>(defun fprint-init (m n atoms)</div><div>  (let ((atoms (subst () () atoms)))</div>

<div>    (do ((a atoms (cdr a)))</div><div><span class="Apple-tab-span" style="white-space:pre">    </span>((null (cdr a)) (rplacd a atoms)))</div><div>    (fprint-init-aux m n atoms)))</div><div><br></div><div>(defvar *fprint-test-pattern* (fprint-init 6. 6. *fprint-test-atoms*))</div>

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

<div>      (pprint *fprint-test-pattern* sink))))</div><div><br></div><div>(time (dotimes (i 20) (fprint/pretty)))</div></div><div><br></div>-- <br>Instituto de Física Fundamental, CSIC<br>c/ Serrano, 113b, Madrid 28006 (Spain) <br>

<a href="http://juanjose.garciaripoll.googlepages.com" target="_blank">http://juanjose.garciaripoll.googlepages.com</a><br>
</div></div>