From 37bef783db591d79da602cb5eb5ea453bb46dc6d Mon Sep 17 00:00:00 2001
From: Alex Klinkhamer <grencez@gmail.com>
Date: Thu, 24 Jul 2008 21:49:20 -0400
Subject: [PATCH] +Complex numbers handled better

---
 src/globals.lisp          |  1 +
 src/overload/format.lisp  | 50 ++++++++++++++++++++++++++++++++---------------
 src/overload/numbers.lisp |  5 +++++
 3 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/src/globals.lisp b/src/globals.lisp
index 314b701..5ceea83 100644
--- a/src/globals.lisp
+++ b/src/globals.lisp
@@ -62,4 +62,5 @@
 
 (store-vrbl "pi" pi)
 (store-vrbl "e" (exp 1))
+(store-vrbl "i" (complex 0 1))
 
diff --git a/src/overload/format.lisp b/src/overload/format.lisp
index f3e80d2..9e9c706 100644
--- a/src/overload/format.lisp
+++ b/src/overload/format.lisp
@@ -2,22 +2,40 @@
 (defgeneric over-format (a strm))
 
 (defmethod over-format ((n float) s)
-  (let ((sig-figs 9);*sig-figs*)
-        (mag 0)
-        (neg (when (minusp n)
-               (setq n (- n)) t)))
-    (cond
-      ((zerop n))
-      ((< n 1d0)
-       (loop :do (decf mag)
-             :while (< (setq n (* n 10)) 1)))
-      ((< n 10d0))
-      (t (loop :do (incf mag)
-               :until (< (setq n (/ n 10)) 10))))
-    (princ (/ (round (* (if neg (- n) n)
-                        (expt 10 sig-figs)))
-              (expt 10d0 (- sig-figs mag)))
-           s)))
+  (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)))))
+
+(defmethod over-format ((n complex) s)
+  (cond
+    ((zerop (imagpart n))
+     (over-format (realpart n) s))
+    ((zerop (realpart n))
+     (over-format (imagpart n) s)
+     (write-char #\i s))
+    (t (over-format (realpart n) s)
+       (over-format
+         (if (plusp (imagpart n))
+           (progn (princ " + " s)
+                  (imagpart n))
+           (progn (princ " - " s)
+                  (- (imagpart n))))
+         s)
+       (write-char #\i s))))
 
 (defmethod over-format ((a number) s)
   (princ a s))
diff --git a/src/overload/numbers.lisp b/src/overload/numbers.lisp
index dae611c..d2cc8e5 100644
--- a/src/overload/numbers.lisp
+++ b/src/overload/numbers.lisp
@@ -7,6 +7,11 @@
 (defmethod mult2n ((a number) (b number)) (* a b))
 (defmethod divis2n ((a number) (b number)) (/ a b))
 
+(defun over-sqrt (n)
+  (if (= n -1)
+    (complex 0 1)
+    (sqrt n)))
+
 (defun over-factorial (n)
   (declare (type (integer 0 *) n))
   (factorial n))
-- 
2.11.4.GIT