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   (multiple-value-bind
   9     (igr tmp) (truncate n)
  10     (princ igr s)
  11     (write-char #\. s)
  12     ;; Cut off after 7 post-decimal digits
  13     (setq igr (round (* tmp 10000000)))
  14     (do ((lis nil)
  15          (itersrem 7 (1- itersrem)))
  16       ((zerop itersrem)
  17        (dolist (digit lis) (princ digit s)))
  18       (multiple-value-setq
  19         (igr tmp) (floor igr 10))
  20       (when (or lis (not (zerop tmp)))
  21         (push tmp lis)))))
  22
  23 (defmethod over-format ((n complex) s)
  24   (cond
  25     ((zerop (imagpart n))
  26      (over-format (realpart n) s))
  27     ((zerop (realpart n))
  28      (over-format (imagpart n) s)
  29      (write-char #\i s))
  30     (t (over-format (realpart n) s)
  31        (over-format
  32          (if (plusp (imagpart n))
  33            (progn (princ " + " s)
  34                   (imagpart n))
  35            (progn (princ " - " s)
  36                   (- (imagpart n))))
  37          s)
  38        (write-char #\i s))))
  39
  40 (defmethod over-format ((a number) s)
  41   (princ a s))
  42 (defmethod over-format ((a cons) s)
  43   (output-tuple a s))
  44 (defmethod over-format ((a tuple) s)
  45   (output-tuple (tuple-elems a) s))
  46 (defmethod over-format ((a mtrix) s)
  47   (output-matrix (mtrix-elems a) s))
  48
  49 (defmethod over-format ((a string) strm)
  50   (princ a strm)
  51   (fresh-line strm))
  52