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      (over-format (imagpart n) s)
  26      (write-char #\i s))
  27     (t (over-format (realpart n) s)
  28        (over-format
  29          (if (plusp (imagpart n))
  30            (progn (princ " + " s)
  31                   (imagpart n))
  32            (progn (princ " - " s)
  33                   (- (imagpart n))))
  34          s)
  35        (write-char #\i s))))
  36
  37 (defmethod over-format ((a number) s)
  38   (princ a s))
  39 (defmethod over-format ((a cons) s)
  40   (output-tuple a s))
  41 (defmethod over-format ((a tuple) s)
  42   (output-tuple (tuple-elems a) s))
  43 (defmethod over-format ((a mtrix) s)
  44   (output-matrix (mtrix-elems a) s))
  45
  46 (defmethod over-format ((a string) strm)
  47   (princ a strm)
  48   (fresh-line strm))
  49