+Fixed rounding error on floats.
authorAlex Klinkhamer <grencez@gmail.com>
Fri, 25 Jul 2008 02:08:21 +0000 (24 22:08 -0400)
committerAlex Klinkhamer <grencez@gmail.com>
Fri, 25 Jul 2008 02:08:21 +0000 (24 22:08 -0400)
src/devvars.lisp
src/overload/format.lisp

index 7716c08..019cc2c 100644 (file)
@@ -1,4 +1,7 @@
 
+;;; Just in case.
+(setq *read-default-float-format* 'double-float)
+
 (defpackage :lineal.devvars
   (:use :cl)
   (:export *file-tree* compile-if-new compile-lineal))
index 9e9c706..782481d 100644 (file)
@@ -5,20 +5,17 @@
   (when (minusp n)
     (write-char #\- s)
     (setq n (- n)))
-  (multiple-value-bind
-    (igr tmp) (truncate n)
-    (princ igr s)
-    (write-char #\. s)
-    ;; Cut off after 7 post-decimal digits
-    (setq igr (round (* tmp 10000000)))
-    (do ((lis nil)
-         (itersrem 7 (1- itersrem)))
-      ((zerop itersrem)
-       (dolist (digit lis) (princ digit s)))
-      (multiple-value-setq
-        (igr tmp) (floor igr 10))
-      (when (or lis (not (zerop tmp)))
-        (push tmp lis)))))
+  ;; Cut off after 7 post-decimal digits
+  (do ((igr (round (* n 10000000)))
+       digit
+       (lis nil)
+       (itersrem 7 (1- itersrem)))
+    ((zerop itersrem)
+     (format s "~D.~{~D~}" igr lis))
+    (multiple-value-setq
+      (igr digit) (floor igr 10))
+    (when (or lis (not (zerop digit)))
+      (push digit lis))))
 
 (defmethod over-format ((n complex) s)
   (cond