Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26913

Modified Files: format.lisp Log Message: Tune-up of format-float: Round off the last digit properly.

Date: Fri Jul 30 15:15:23 2004 Author: ffjeld

Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.6 movitz/losp/muerte/format.lisp:1.7 --- movitz/losp/muerte/format.lisp:1.6 Thu Jul 29 09:21:39 2004 +++ movitz/losp/muerte/format.lisp Fri Jul 30 15:15:23 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sat Mar 23 01:18:36 2002 ;;;; -;;;; $Id: format.lisp,v 1.6 2004/07/29 16:21:39 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.7 2004/07/30 22:15:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -59,21 +59,27 @@ (*print-readably* nil)) (write x))))

-(defun format-float (x &optional at-sign-p colon-p w d k overflowchar padchar) - (declare (ignore w k overflowchar padchar at-sign-p colon-p)) - (multiple-value-bind (integer-part decimal-part) - (truncate x) - (write-integer integer-part *standard-output* 10 t) - (do ((remainder decimal-part) - (i 0 (1+ i))) - ((if (not d) - (or (and (plusp i) (zerop decimal-part)) - (>= i 16)) - (= i d))) - (multiple-value-bind (next-digit next-remainder) - (truncate (* 10 remainder)) - (setf remainder next-remainder) - (write-integer next-digit *standard-output* 10 nil))))) +(defun format-float (x &optional at-sign-p colon-p w d (k 0) overflowchar padchar) + (declare (ignore w overflowchar padchar at-sign-p colon-p)) + (if (eql 0 d) + (write-integer (round x) *standard-output* 10 nil) + (multiple-value-bind (integer-part decimal-part) + (truncate x) + (write-integer integer-part *standard-output* 10 nil) + (dotimes (i k) + (write-char #\0)) + (write-char #.) + (do ((remainder decimal-part) + (last-i (if d (1- d) 15)) + (i 0 (1+ i))) + ((or (and (not d) (plusp i) (zerop remainder)) + (> i last-i))) + (multiple-value-bind (next-digit next-remainder) + (if (= i last-i) + (round (* 10 remainder)) + (truncate (* 10 remainder))) + (setf remainder next-remainder) + (write-digit next-digit *standard-output*))))))

(defun find-directive (string i directive &optional recursive-skip-start (recursive-skip-end directive))