mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 22:01:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

format-f: Rework printing body to conform to ANSI standard.

Browse source 
Signed-off-by: Daniel Kochmański <dkochmanski@turtle-solutions.eu>
This commit is contained in:
Daniel Kochmański 2015-05-11 22:07:14 +02:00
parent 21f10c6e50
commit e1fdc1ea03
1 changed files with 30 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

45
src/lsp/format.lsp
View file

@ -144,28 +144,43 @@
(values-list f)))))
(let* ((exp (+ e scale))
(stream (make-string-output-stream))
(length (length string))
(flength (- length exp)))
(length (length string)))
;; Integer part
(when (plusp exp)
(write-string string
stream
:end (min length exp))
(dotimes (i (- flength))
(dotimes (i (- exp length))
(write-char #\0 stream)))
;; Separator
;; Separator and fraction
(write-char #\. stream)
;; Float part
(when (minusp exp)
(dotimes (i (abs exp))
(write-char #\0 stream)))
(write-string string
stream
:start (max 0 (min length exp)))
(when fdigits
(dotimes (i (- fdigits (max flength 0)))
(write-char #\0 stream)))
;; Fraction part
(cond ((and zero? fdigits)
(dotimes (i fdigits)
(write-char #\0 stream)))
(fdigits
(let ((characters-used 0))
(dotimes (i (min (- exp) fdigits))
(incf characters-used)
(write-char #\0 stream))
(let* ((start (max 0 (min length exp)))
(end (max start
(min length
(+ start (- fdigits characters-used))))))
(write-string string stream
:start start
:end end)
(incf characters-used (- end start))
(dotimes (i (- fdigits characters-used))
(write-char #\0 stream)))))
(zero?
(write-char #\0 stream))
(T
(dotimes (i (- exp))
(write-char #\0 stream))
(let ((start (max 0 (min length exp))))
(write-string string stream
:start start))))
(let* ((string (get-output-stream-string stream))
(length (length string))
(position (position #\. string)))