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

float: flonum-to-string: Use normal if instead of 2-clause cond.

Browse source 
Signed-off-by: Daniel Kochmański <dkochmanski@turtle-solutions.eu>
This commit is contained in:
Daniel Kochmański 2015-05-10 21:44:54 +02:00
parent debc074c74
commit 7798163815
1 changed files with 65 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

131
src/lsp/format.lsp
View file

@ -97,73 +97,72 @@
(defun flonum-to-string (x &optional width fdigits (scale 0) (fmin 0))
(declare (type float x))
(cond ((zerop x)
;; Zero is a special case which FLOAT-STRING cannot handle.
(cond ((null fdigits)
(values ".0" 2 t nil 0))
((zerop fdigits)
(values "0." 2 nil t 1))
(T
(let ((s (make-string (1+ fdigits) :initial-element #\0)))
(setf (schar s 0) #\.)
(values s (length s) t nil 0)))))
(t
(multiple-value-bind (e string)
(cond
(fdigits
(float-to-digits nil x
(min (- (+ fdigits scale))
(- fmin))
nil))
((null width)
(float-to-digits nil x nil nil))
(T (let ((w (multiple-value-list
(float-to-digits nil x
(max 0
(+ (1- width)
(if (minusp scale)
scale 0)))
t)))
(f (multiple-value-list
(float-to-digits nil x
(- (+ fmin scale))
nil))))
(if (>= (length (cadr w))
(length (cadr f)))
(values-list w)
(values-list f)))))
(let* ((exp (+ e scale))
(stream (make-string-output-stream))
(length (length string))
(flength (- length exp)))
;; Integer part
(when (plusp exp)
(write-string string
stream
:end (min length exp))
(dotimes (i (- flength))
(write-char #\0 stream)))
;; Separator
(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)))
(if (zerop x)
;; Zero is a special case which FLOAT-STRING cannot handle.
(cond ((null fdigits)
(values ".0" 2 t nil 0))
((zerop fdigits)
(values "0." 2 nil t 1))
(T
(let ((s (make-string (1+ fdigits) :initial-element #\0)))
(setf (schar s 0) #\.)
(values s (length s) t nil 0))))
(multiple-value-bind (e string)
(cond
(fdigits
(float-to-digits nil x
(min (- (+ fdigits scale))
(- fmin))
nil))
((null width)
(float-to-digits nil x nil nil))
(T (let ((w (multiple-value-list
(float-to-digits nil x
(max 0
(+ (1- width)
(if (minusp scale)
scale 0)))
t)))
(f (multiple-value-list
(float-to-digits nil x
(- (+ fmin scale))
nil))))
(if (>= (length (cadr w))
(length (cadr f)))
(values-list w)
(values-list f)))))
(let* ((exp (+ e scale))
(stream (make-string-output-stream))
(length (length string))
(flength (- length exp)))
;; Integer part
(when (plusp exp)
(write-string string
stream
:end (min length exp))
(dotimes (i (- flength))
(write-char #\0 stream)))
;; Separator
(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)))
(let* ((string (get-output-stream-string stream))
(length (length string))
(position (position #\. string)))
(values string
length
(= position 0)
(= position (1- length))
position)))))))
(let* ((string (get-output-stream-string stream))
(length (length string))
(position (position #\. string)))
(values string
length
(= position 0)
(= position (1- length))
position))))))
;;; SCALE-EXPONENT -- Internal
;;;