src/overload/format.lisp

   1
   2 (defgeneric over-format (a strm))
   3
   4 (defmethod over-format ((n float) s)
   5   (when (minusp n)
   6     (write-char #\- s)
   7     (setq n (- n)))
   8   ;; Cut off after 7 post-decimal digits
   9   (do ((igr (round (* n 10000000)))
  10        digit
  11        (lis nil)
  12        (itersrem 7 (1- itersrem)))
  13     ((zerop itersrem)
  14      (format s "~D.~{~D~}" igr lis))
  15     (multiple-value-setq
  16       (igr digit) (floor igr 10))
  17     (when (or lis (not (zerop digit)))
  18       (push digit lis))))
  19
  20 (defmethod over-format ((n complex) s)
  21   (cond
  22     ((zerop (imagpart n))
  23      (over-format (realpart n) s))
  24     ((zerop (realpart n))
  25      (case (imagpart n) (1)
  26        (-1 (write-char #\- s))
  27        (t (over-format (imagpart n) s)))
  28      (write-char #\i s))
  29     (t (over-format (realpart n) s)
  30        (let ((tmp
  31                (if (plusp (imagpart n))
  32                  (progn (princ " + " s)
  33                         (imagpart n))
  34                  (progn (princ " - " s)
  35                         (- (imagpart n))))))
  36          (unless (= tmp 1)
  37            (over-format tmp s)))
  38        (write-char #\i s))))
  39
  40 (defmethod over-format ((a number) s)
  41   (princ a s))
  42 (defmethod over-format ((a tuple) s)
  43   (output-tuple (tuple-elems a) s))
  44 (defmethod over-format ((a mtrix) s)
  45   (output-matrix (mtrix-elems a) s))
  46
  47 (defmethod over-format ((a string) strm)
  48   (princ a strm)
  49   (fresh-line strm))
  50