From cc3b31f02df687765ec71195dadd0475df8bd074 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 09:40:10 +0200 Subject: [PATCH 01/30] format: flotnum-to-string: scale and fmin parameters default to 0. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Specification says, that scale parameter defaults to 0 (same applis to fmin in regard of implementation). Both parameters were sanity checked all over the function flotnum-to-string. This change simplifies the code in regard of removing this sanity-checks due to sane default. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index d18054f26..787610312 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -13,6 +13,9 @@ ;;; ;;; Written by William Lott, with lots of stuff stolen from the previous ;;; version by David Adam and later rewritten by Bill Maddox. +;;; +;;; Various fixes and adaptations provided by Juan Jose Garcia-Ripoll and +;;; other Embeddable Common-Lisp developers. ;;; (in-package "SYS") @@ -92,7 +95,7 @@ (defparameter *digits* "0123456789") -(defun flonum-to-string (x &optional width fdigits scale fmin) +(defun flonum-to-string (x &optional width fdigits (scale 0) (fmin 0)) (declare (type float x)) ;; FIXME: I think only FORMAT-DOLLARS calls FLONUM-TO-STRING with ;; possibly-negative X. @@ -108,28 +111,27 @@ (multiple-value-bind (e string) (if fdigits (float-to-digits nil x - (min (- (+ fdigits (or scale 0))) - (- (or fmin 0))) + (min (- (+ fdigits scale)) + (- fmin)) nil) (if (and width (> width 1)) (let ((w (multiple-value-list (float-to-digits nil x (max 1 (+ (1- width) - (if (and scale (minusp scale)) + (if (minusp scale) scale 0))) t))) (f (multiple-value-list (float-to-digits nil x - (- (+ (or fmin 0) - (if scale scale 0))) + (- (+ fmin scale)) nil)))) (cond ((>= (length (cadr w)) (length (cadr f))) (values-list w)) (t (values-list f)))) (float-to-digits nil x nil nil))) - (let ((e (+ e (or scale 0))) + (let ((e (+ e scale)) (stream (make-string-output-stream))) (if (plusp e) (progn @@ -1292,7 +1294,7 @@ (error 'format-error :complaint "Cannot specify the colon modifier with this directive.")) - (expand-bind-defaults ((w nil) (d nil) (k nil) (ovf nil) (pad #\space)) params + (expand-bind-defaults ((w nil) (d nil) (k 0) (ovf nil) (pad #\space)) params `(format-fixed stream ,(expand-next-arg) ,w ,d ,k ,ovf ,pad ,atsignp))) (def-format-interpreter #\F (colonp atsignp params) @@ -1300,7 +1302,7 @@ (error 'format-error :complaint "Cannot specify the colon modifier with this directive.")) - (interpret-bind-defaults ((w nil) (d nil) (k nil) (ovf nil) (pad #\space)) + (interpret-bind-defaults ((w nil) (d nil) (k 0) (ovf nil) (pad #\space)) params (format-fixed stream (next-arg) w d k ovf pad atsignp))) @@ -1441,7 +1443,7 @@ (estr (decimal-string (abs expt))) (elen (if e (max (length estr) e) (length estr))) (fdig (if d (if (plusp k) (1+ (- d k)) d) nil)) - (fmin (if (minusp k) (- 1 k) nil)) + (fmin (if (minusp k) (- 1 k) 0)) (spaceleft (if w (- w 2 elen (if (or atsign (minusp number)) @@ -1485,7 +1487,7 @@ :complaint "Cannot specify the colon modifier with this directive.")) (expand-bind-defaults - ((w nil) (d nil) (e nil) (k nil) (ovf nil) (pad #\space) (mark nil)) + ((w nil) (d nil) (e nil) (k 0) (ovf nil) (pad #\space) (mark nil)) params `(format-general stream ,(expand-next-arg) ,w ,d ,e ,k ,ovf ,pad ,mark ,atsignp))) @@ -1495,7 +1497,7 @@ :complaint "Cannot specify the colon modifier with this directive.")) (interpret-bind-defaults - ((w nil) (d nil) (e nil) (k nil) (ovf nil) (pad #\space) (mark nil)) + ((w nil) (d nil) (e nil) (k 0) (ovf nil) (pad #\space) (mark nil)) params (format-general stream (next-arg) w d e k ovf pad mark atsignp))) @@ -1541,7 +1543,7 @@ (ww (if w (- w ee) nil)) (dd (- d n))) (cond ((<= 0 dd d) - (let ((char (if (format-fixed-aux stream number ww dd nil + (let ((char (if (format-fixed-aux stream number ww dd 0 ovf pad atsign) ovf #\space))) @@ -1567,7 +1569,7 @@ (let* ((signstr (if (minusp number) "-" (if atsign "+" ""))) (signlen (length signstr))) (multiple-value-bind (str strlen ig2 ig3 pointplace) - (sys::flonum-to-string number nil d nil) + (sys::flonum-to-string number nil d) (declare (ignore ig2 ig3)) (when colon (write-string signstr stream)) (dotimes (i (- w signlen (max 0 (- n pointplace)) strlen)) From 5536f98294e35d6672963f0523af69a370f65c4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 11:57:45 +0200 Subject: [PATCH 02/30] format: flotnum-to-string: Resolve FIXME regarding non-negative input. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `floatnum-to-string` requires it's first argument to be non-negative number. To assure that, it was setting it to it's abs, with FIXME hint, that only one function seems to be able to pass negative number there. This commit assures, that mentioned function passes non-negative argument. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 787610312..c8a37df7f 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -97,9 +97,6 @@ (defun flonum-to-string (x &optional width fdigits (scale 0) (fmin 0)) (declare (type float x)) - ;; FIXME: I think only FORMAT-DOLLARS calls FLONUM-TO-STRING with - ;; possibly-negative X. - (setf x (abs x)) (cond ((zerop x) ;; Zero is a special case which FLOAT-STRING cannot handle. (if fdigits @@ -1569,7 +1566,7 @@ (let* ((signstr (if (minusp number) "-" (if atsign "+" ""))) (signlen (length signstr))) (multiple-value-bind (str strlen ig2 ig3 pointplace) - (sys::flonum-to-string number nil d) + (sys::flonum-to-string (abs number) nil d) (declare (ignore ig2 ig3)) (when colon (write-string signstr stream)) (dotimes (i (- w signlen (max 0 (- n pointplace)) strlen)) From 612b6bb64bb796a3ce6479ff06ed78f518e373bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 12:00:52 +0200 Subject: [PATCH 03/30] format: floats: Fix non-conformity bug regarding output characters. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When width is supplied to format, CLHS 22.3.3.1 Says "Exactly w characters will be output." This patch fixes this non-conformity to count separator (".") as well. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index c8a37df7f..f4e710447 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1337,7 +1337,7 @@ (when (and w (or atsign (minusp number))) (decf spaceleft)) (multiple-value-bind (str len lpoint tpoint) - (sys::flonum-to-string (abs number) spaceleft d k) + (sys::flonum-to-string (abs number) (1- spaceleft) d k) ;;if caller specifically requested no fraction digits, suppress the ;;optional trailing zero (when (and d (zerop d)) (setq tpoint nil)) From 5201c28148fac1b415fc22b9a8b11f39f8541042 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 14:17:33 +0200 Subject: [PATCH 04/30] buildsystem: tests: fix archives mirror address. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/tests/config.lsp.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tests/config.lsp.in b/src/tests/config.lsp.in index 21e9c579a..53fce9aa8 100755 --- a/src/tests/config.lsp.in +++ b/src/tests/config.lsp.in @@ -58,19 +58,19 @@ (defvar *regressions-sandbox* (merge-pathnames "regressions/" *here*)) -(defvar *ansi-tests-mirror* "http://ecls.sourceforge.net/ansi-tests.tar.gz") +(defvar *ansi-tests-mirror* "https://common-lisp.net/project/ecl/tests/ansi-tests.tar.gz") (defvar *ansi-tests-sandbox* (merge-pathnames "ansi-tests/" *here*)) (defvar *ansi-tests-tarball* "ansi-tests.tar.gz") -(defvar *mop-tests-mirror* "http://ecls.sourceforge.net/mop-features.tar.gz") +(defvar *mop-tests-mirror* "https://common-lisp.net/project/ecl/tests/mop-features.tar.gz") (defvar *mop-tests-sandbox* (merge-pathnames "mop-features/" *here*)) (defvar *mop-tests-tarball* "mop-features.tar.gz") -(defvar *fricas-mirror* "http://ecls.sourceforge.net/fricas.tar.gz") +(defvar *fricas-mirror* "https://common-lisp.net/project/ecl/tests/fricas.tar.gz") (defvar *fricas-sandbox* (merge-pathnames "fricas/" *here*)) From c95e07bc09b31bcb12260a17492d3f67808b6c59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 14:49:35 +0200 Subject: [PATCH 05/30] format: Update documentating commet to reflect new fmin and scale defaults. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index f4e710447..002d065f5 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -49,10 +49,10 @@ ;;; unspecified or NIL, in which case as many digits as possible ;;; are generated, subject to the constraint that there are no ;;; trailing zeroes. -;;; SCALE - If this parameter is specified or non-NIL, then the number +;;; SCALE - If this parameter is specified or non-zero, then the number ;;; printed is (* x (expt 10 scale)). This scaling is exact, ;;; and cannot lose precision. -;;; FMIN - This parameter, if specified or non-NIL, is the minimum +;;; FMIN - This parameter, if specified or non-zero, is the minimum ;;; number of fraction digits which will be produced, regardless ;;; of the value of WIDTH or FDIGITS. This feature is used by ;;; the ~E format directive to prevent complete loss of From 3efcb4ed78766329892166c6a2cc48e2de822c89 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 9 May 2015 15:27:54 +0200 Subject: [PATCH 06/30] format: float: fix bug causing error, when no width is claimed. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 002d065f5..fa39598c3 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1333,11 +1333,14 @@ (prin1 number stream) nil) (t - (let ((spaceleft w)) + (let* ((spaceleft w) + (digits (if (null spaceleft) + nil + (1- spaceleft)))) (when (and w (or atsign (minusp number))) (decf spaceleft)) (multiple-value-bind (str len lpoint tpoint) - (sys::flonum-to-string (abs number) (1- spaceleft) d k) + (sys::flonum-to-string (abs number) digits d k) ;;if caller specifically requested no fraction digits, suppress the ;;optional trailing zero (when (and d (zerop d)) (setq tpoint nil)) From 5cbb3b905ab3e93ea1d935a8c0b10d05abcb2be5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 15:14:49 +0200 Subject: [PATCH 07/30] format: flonum-to-string: rework nested IF statements as cond. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Simplifies code. Also creates additional clause (commented now) to handle special case, when width is too small to display number. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 51 ++++++++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index fa39598c3..e5cc87663 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -106,28 +106,35 @@ (values "." 1 t t 0))) (t (multiple-value-bind (e string) - (if fdigits - (float-to-digits nil x - (min (- (+ fdigits scale)) - (- fmin)) - nil) - (if (and width (> width 1)) - (let ((w (multiple-value-list - (float-to-digits nil x - (max 1 - (+ (1- width) - (if (minusp scale) - scale 0))) - t))) - (f (multiple-value-list - (float-to-digits nil x - (- (+ fmin scale)) - nil)))) - (cond - ((>= (length (cadr w)) (length (cadr f))) - (values-list w)) - (t (values-list f)))) - (float-to-digits nil x nil nil))) + (cond + ((not (null fdigits)) + (float-to-digits nil x + (min (- (+ fdigits scale)) + (- fmin)) + nil)) + ((null width) + (float-to-digits nil x nil nil)) + ;; ((= width 1) + ;; ;; This is a corner case. CLHS indicates, that minimal + ;; ;; number of characters required to print a value + ;; ;; should be used. + ;; (float-to-digits nil x nil nil)) + (T (let ((w (multiple-value-list + (float-to-digits nil x + (max 1 + (+ (1- width) + (if (minusp scale) + scale 0))) + t))) + (f (multiple-value-list + (float-to-digits nil x + (- (+ fmin scale)) + nil)))) + (format t "width is ~A, w is ~A~&" width w) + (if (>= (length (cadr w)) + (length (cadr f))) + (values-list w) + (values-list f))))) (let ((e (+ e scale)) (stream (make-string-output-stream))) (if (plusp e) From 1e2d00ed3a0a89ee7e526016eb13c52f9e4d5afb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 20:13:06 +0200 Subject: [PATCH 08/30] format: flonum-to-string: Fix corner-case when printing "0.0". MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When printing 0.0 and fdigits parameter set to 0 or nil, single "." was printed, what is not valid float number. Now it at least prints ".0". Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index e5cc87663..a5f18c565 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -99,11 +99,11 @@ (declare (type float x)) (cond ((zerop x) ;; Zero is a special case which FLOAT-STRING cannot handle. - (if fdigits + (if (and fdigits (/= fdigits 0)) (let ((s (make-string (1+ fdigits) :initial-element #\0))) (setf (schar s 0) #\.) - (values s (length s) t (zerop fdigits) 0)) - (values "." 1 t t 0))) + (values s (length s) t nil 0)) + (values ".0" 2 t nil 0))) (t (multiple-value-bind (e string) (cond From ac4f2fd3234e0b00d36aff3de1757799f24d7c50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:18:31 +0200 Subject: [PATCH 09/30] format: flonum-to-string: cover another corner-case when printing 0. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When user supplies "0.0" to format and fdigits parameter is nil, then ".0" should be printed (at least). If fdigits is set to zero, then correct result is "0.". For values 1 and more appropriate number of zeros after period is printed. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index a5f18c565..f8999cf55 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -99,11 +99,14 @@ (declare (type float x)) (cond ((zerop x) ;; Zero is a special case which FLOAT-STRING cannot handle. - (if (and fdigits (/= fdigits 0)) - (let ((s (make-string (1+ fdigits) :initial-element #\0))) - (setf (schar s 0) #\.) - (values s (length s) t nil 0)) - (values ".0" 2 t nil 0))) + (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 From ac5f80ab29926aa5e406ff363b681a16489bd34f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:31:42 +0200 Subject: [PATCH 10/30] format: format-fixed-aux: trailing zero is obligatory. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Trailing zero is obligatory unless d is explicitly set to 0. Consider following example: (format nil "~0f" 3.0) ; 3.0 If trailing zero is optional, then 3. would be printed and this would be an integer (not float). If d is explicitly set to 0 we assume, that programmer knows what he's doing and tries to convert float to integer. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index f8999cf55..06dfdaaa6 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1356,16 +1356,14 @@ (when (and d (zerop d)) (setq tpoint nil)) (when w (decf spaceleft len) - ;;optional leading zero + ;; obligatory trailing zero (unless explicitly cut with ,d) + (when tpoint + (decf spaceleft)) + ;; optional leading zero (when lpoint - (if (or (> spaceleft 0) tpoint) ;force at least one digit - (decf spaceleft) - (setq lpoint nil))) - ;;optional trailing zero - (when tpoint (if (> spaceleft 0) - (decf spaceleft) - (setq tpoint nil)))) + (decf spaceleft) + (setq lpoint nil)))) (cond ((and w (< spaceleft 0) ovf) ;;field width overflow (dotimes (i w) (write-char ovf stream)) From 0f68b54cf1c9514f2ea6495a33360812b89b9882 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:36:30 +0200 Subject: [PATCH 11/30] format: flonum-to-string: Remove special case when width is 1. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This "special case" isn't general enough to cover situations, when width is too small. If we print ie "3.1421", then at least three characters are required, but printing "0.1231" requires only two of them. Also 0 is a valid argument forcing using minimal set of characters to print number reliably (with smallest accuracy possible). Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 06dfdaaa6..dca567cfe 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -117,14 +117,9 @@ nil)) ((null width) (float-to-digits nil x nil nil)) - ;; ((= width 1) - ;; ;; This is a corner case. CLHS indicates, that minimal - ;; ;; number of characters required to print a value - ;; ;; should be used. - ;; (float-to-digits nil x nil nil)) (T (let ((w (multiple-value-list (float-to-digits nil x - (max 1 + (max 0 (+ (1- width) (if (minusp scale) scale 0))) From debc074c746a2f3259fbdf7df1f5216411238dd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:42:55 +0200 Subject: [PATCH 12/30] format: flonum-to-string: Simplify writing a string. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Instead of two separate overlapping cases use generalized algorithm. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 64 ++++++++++++++++++++++++---------------------- 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index dca567cfe..ef8b0200a 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -110,7 +110,7 @@ (t (multiple-value-bind (e string) (cond - ((not (null fdigits)) + (fdigits (float-to-digits nil x (min (- (+ fdigits scale)) (- fmin)) @@ -128,40 +128,42 @@ (float-to-digits nil x (- (+ fmin scale)) nil)))) - (format t "width is ~A, w is ~A~&" width w) (if (>= (length (cadr w)) (length (cadr f))) (values-list w) (values-list f))))) - (let ((e (+ e scale)) - (stream (make-string-output-stream))) - (if (plusp e) - (progn - (write-string string stream :end (min (length string) - e)) - (dotimes (i (- e (length string))) - (write-char #\0 stream)) - (write-char #\. stream) - (write-string string stream :start (min (length - string) e)) - (when fdigits - (dotimes (i (- fdigits - (- (length string) - (min (length string) e)))) - (write-char #\0 stream)))) - (progn - (write-string "." stream) - (dotimes (i (- e)) - (write-char #\0 stream)) - (write-string string stream) - (when fdigits - (dotimes (i (+ fdigits e (- (length string)))) - (write-char #\0 stream))))) - (let ((string (get-output-stream-string stream))) - (values string (length string) - (char= (char string 0) #\.) - (char= (char string (1- (length string))) #\.) - (position #\. string)))))))) + (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))))))) ;;; SCALE-EXPONENT -- Internal ;;; From 7798163815cb4fca71b8bf4d8934e8d9b4988edf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:44:54 +0200 Subject: [PATCH 13/30] float: flonum-to-string: Use normal if instead of 2-clause cond. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 131 ++++++++++++++++++++++----------------------- 1 file changed, 65 insertions(+), 66 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index ef8b0200a..3f5c7f887 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -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 ;;; From 30ce3bb40821946c21422eede76c3e659309d735 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 21:50:43 +0200 Subject: [PATCH 14/30] cosmetic: indentation fix. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 51 +++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 3f5c7f887..a6d99d590 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -108,29 +108,28 @@ (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))))) + (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)) @@ -1349,7 +1348,8 @@ (sys::flonum-to-string (abs number) digits d k) ;;if caller specifically requested no fraction digits, suppress the ;;optional trailing zero - (when (and d (zerop d)) (setq tpoint nil)) + (when (and d (zerop d)) + (setq tpoint nil)) (when w (decf spaceleft len) ;; obligatory trailing zero (unless explicitly cut with ,d) @@ -1362,7 +1362,8 @@ (setq lpoint nil)))) (cond ((and w (< spaceleft 0) ovf) ;;field width overflow - (dotimes (i w) (write-char ovf stream)) + (dotimes (i w) + (write-char ovf stream)) t) (t (when w (dotimes (i spaceleft) (write-char pad stream))) From 8b0b31f34e6f421187967f9e7afb5c2bae53a4bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 10 May 2015 22:08:53 +0200 Subject: [PATCH 15/30] format: format-fixed-aux: decrement digits when sign is printed. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bugfix: decrement number of digitse provided to `flonum-to-string` if sign is also to be printed. Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index a6d99d590..0d76ce80d 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1342,7 +1342,10 @@ (digits (if (null spaceleft) nil (1- spaceleft)))) - (when (and w (or atsign (minusp number))) (decf spaceleft)) + (when (and w (or atsign + (minusp number))) + (decf spaceleft) + (decf digits)) (multiple-value-bind (str len lpoint tpoint) (sys::flonum-to-string (abs number) digits d k) From bfa1f614eda89329cce69e0984f97eda294fb266 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 11:05:41 +0200 Subject: [PATCH 16/30] format: flonum-to-string: Minimal width for numbers is 1 not 0. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 0d76ce80d..0c06e1683 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -117,7 +117,7 @@ (float-to-digits nil x nil nil)) (T (let ((w (multiple-value-list (float-to-digits nil x - (max 0 + (max 1 (+ (1- width) (if (minusp scale) scale 0))) From 887770281deb513f1dd78204aee1ac602f355c35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 21:35:33 +0200 Subject: [PATCH 17/30] fromat-f: Create wrapper function float-to-digits* detecting zero. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If printed float is effectively zero, then if not explicitly specified by `fdigits` it should be printed as 0.0 (or .0 if width is too small). Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 0c06e1683..710b463d5 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -95,6 +95,18 @@ (defparameter *digits* "0123456789") +(defun float-to-digits* (digits number position relativep) + "Does what float-to-digits, but also detects if result is zero." + (multiple-value-bind (exp string) + (float-to-digits digits + number + position + relativep) + (values exp + string + (and position + (< exp (- (abs position))))))) + (defun flonum-to-string (x &optional width fdigits (scale 0) (fmin 0)) (declare (type float x)) (if (zerop x) From c02ffa180c9145aa95476fce1b26c7dfa656ea66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 21:37:38 +0200 Subject: [PATCH 18/30] fromat-f: Use new wrapper function float-to-digits*. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 710b463d5..f29914229 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -119,25 +119,24 @@ (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) + (multiple-value-bind (e string zero?) (cond (fdigits - (float-to-digits nil x - (min (- (+ fdigits scale)) - (- fmin)) - nil)) + (float-to-digits* nil x + (min (- (+ fdigits scale)) + (- fmin)) + nil)) ((null width) - (float-to-digits nil x nil nil)) + (float-to-digits* nil x nil nil)) (T (let ((w (multiple-value-list - (float-to-digits nil x - (max 1 - (+ (1- width) - (if (minusp scale) - scale 0))) - t))) + (float-to-digits* nil x + (+ (1- width) + (if (minusp scale) + scale 0)) + t))) (f (multiple-value-list - (float-to-digits nil x - (- (+ fmin scale)) - nil)))) + (float-to-digits* nil x + (- (+ fmin scale)) + nil)))) (if (>= (length (cadr w)) (length (cadr f))) (values-list w) From 5b3231af8a18029e5b03d5cd92a62408782bf928 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 22:02:31 +0200 Subject: [PATCH 19/30] format-f: prevent situation, when single "." is printed. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index f29914229..afe7a36e9 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1362,7 +1362,7 @@ (sys::flonum-to-string (abs number) digits d k) ;;if caller specifically requested no fraction digits, suppress the ;;optional trailing zero - (when (and d (zerop d)) + (when (eql d 0) (setq tpoint nil)) (when w (decf spaceleft len) @@ -1371,7 +1371,8 @@ (decf spaceleft)) ;; optional leading zero (when lpoint - (if (> spaceleft 0) + (if (or (> spaceleft 0) + (eql d 0)) (decf spaceleft) (setq lpoint nil)))) (cond ((and w (< spaceleft 0) ovf) From 21f10c6e50adb2a1812ce6b26b90441d44eeb72c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 22:05:30 +0200 Subject: [PATCH 20/30] format-f: Use sane minimal value for width passed to dragon4. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index afe7a36e9..fd20ef010 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -129,9 +129,10 @@ (float-to-digits* nil x nil nil)) (T (let ((w (multiple-value-list (float-to-digits* nil x - (+ (1- width) - (if (minusp scale) - scale 0)) + (max 0 + (+ (1- width) + (if (minusp scale) + scale 0))) t))) (f (multiple-value-list (float-to-digits* nil x From e1fdc1ea0381d0d09f5062bda4d05662679982ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 22:07:14 +0200 Subject: [PATCH 21/30] format-f: Rework printing body to conform to ANSI standard. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index fd20ef010..7c998908c 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -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))) From c07ff4d314024ca2e36baef56ea418ab178d81c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 22:08:13 +0200 Subject: [PATCH 22/30] format-f: Too much work put into this to not become immortal ;-). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 7c998908c..40aa7c13b 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -15,7 +15,7 @@ ;;; version by David Adam and later rewritten by Bill Maddox. ;;; ;;; Various fixes and adaptations provided by Juan Jose Garcia-Ripoll and -;;; other Embeddable Common-Lisp developers. +;;; Daniel Kochmański for Embeddable Common-Lisp. ;;; (in-package "SYS") From 1bd96da18603242f0232aac670fb7b2ceb0c60b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 11 May 2015 22:15:03 +0200 Subject: [PATCH 23/30] CHANGELOG: add improvement infor. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG b/CHANGELOG index 40553f9e2..df742d52b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -39,6 +39,8 @@ were handled improperly in regard of multiple values. - Improved unicode support in character handling. + + - Format handles floats correctly (algorithm rework). ** Enchantments: From 3e19a62b2d2f6af9c128bf83a3edd5e5d419563a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 08:53:41 +0200 Subject: [PATCH 24/30] format-f: simplify code. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 40aa7c13b..5b9bf6418 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -130,7 +130,7 @@ (T (let ((w (multiple-value-list (float-to-digits* nil x (max 0 - (+ (1- width) + (+ (- width 2) (if (minusp scale) scale 0))) t))) @@ -1365,19 +1365,14 @@ (prin1 number stream) nil) (t - (let* ((spaceleft w) - (digits (if (null spaceleft) - nil - (1- spaceleft)))) + (let ((spaceleft w)) (when (and w (or atsign (minusp number))) - (decf spaceleft) - (decf digits)) - (multiple-value-bind - (str len lpoint tpoint) - (sys::flonum-to-string (abs number) digits d k) - ;;if caller specifically requested no fraction digits, suppress the - ;;optional trailing zero + (decf spaceleft)) + (multiple-value-bind (str len lpoint tpoint) + (sys::flonum-to-string (abs number) spaceleft d k) + ;; if caller specifically requested no fraction digits, suppress the + ;; trailing zero (when (eql d 0) (setq tpoint nil)) (when w From 3d09e65110aa7eb270d3e0104a69f91873113fc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 10:20:01 +0200 Subject: [PATCH 25/30] format-e: Rework nested `if`s to use cond in format-exponential. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 5b9bf6418..f74014188 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1425,18 +1425,19 @@ (defun format-exponential (stream number w d e k ovf pad marker atsign) #-formatter (declare (si::c-local)) - (if (numberp number) - (if (floatp number) - (format-exp-aux stream number w d e k ovf pad marker atsign) - (if (rationalp number) - (format-exp-aux stream - (coerce number 'single-float) - w d e k ovf pad marker atsign) - (format-write-field stream - (decimal-string number) - w 1 0 #\space t))) - (format-princ stream number nil nil w 1 0 pad))) - + (cond + ((not (numberp number)) + (format-princ stream number nil nil w 1 0 pad)) + ((floatp number) + (format-exp-aux stream number w d e k ovf pad marker atsign)) + ((rationalp number) + (format-exp-aux streamn + (coerce number 'single-float) + w d e k ovf pad marker atsign)) + (T + (format-write-field stream + (decimal-string number) + w 1 0 #\space t)))) (defun format-exponent-marker (number) (declare (si::c-local)) From 2023c47c426e9888c430dc93cb1049c718b68969 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 10:20:28 +0200 Subject: [PATCH 26/30] cosmetic: indentation fix. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index f74014188..901eb7a78 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1470,7 +1470,7 @@ #+ecl nil (prin1 number stream) (multiple-value-bind (num expt) - (sys::scale-exponent (abs number)) + (sys::scale-exponent (abs number)) (let* ((expt (- expt k)) (estr (decimal-string (abs expt))) (elen (if e (max (length estr) e) (length estr))) @@ -1483,8 +1483,7 @@ nil))) (if (and w ovf e (> elen e)) ;exponent overflow (dotimes (i w) (write-char ovf stream)) - (multiple-value-bind - (fstr flen lpoint) + (multiple-value-bind (fstr flen lpoint) (sys::flonum-to-string num spaceleft fdig k fmin) (when w (decf spaceleft flen) From 586405328e1bf9d33ef58151e4056f87a82dd07c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 14:58:00 +0200 Subject: [PATCH 27/30] format-e: fix typo. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 901eb7a78..079b8faa9 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -1431,7 +1431,7 @@ ((floatp number) (format-exp-aux stream number w d e k ovf pad marker atsign)) ((rationalp number) - (format-exp-aux streamn + (format-exp-aux stream (coerce number 'single-float) w d e k ovf pad marker atsign)) (T @@ -1471,6 +1471,9 @@ (prin1 number stream) (multiple-value-bind (num expt) (sys::scale-exponent (abs number)) + (when (< expt 0) + (decf k)) + ;; (incf expt)) (let* ((expt (- expt k)) (estr (decimal-string (abs expt))) (elen (if e (max (length estr) e) (length estr))) From afc46ed9815808ca8d3f1913a60aaabbff52ad08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 15:03:06 +0200 Subject: [PATCH 28/30] format-e: adjust scale factor. Closes #39. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/lsp/format.lsp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 079b8faa9..67b5b79c5 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -223,7 +223,7 @@ (setf x (* x 1.0l18) delta -18) #-long-float (setf x (* x 1.0l16) delta -16)) - ;; We find the appropriate factor that keeps the output within (0.1,1] + ;; We find the appropriate factor that keeps the output within [0.1,1) ;; Note that we have to compute the exponential _every_ _time_ in the loop ;; because multiplying just by 10.0l0 every time would lead to a greater ;; loss of precission. @@ -232,12 +232,12 @@ (if (minusp ex) (loop for y of-type long-float = (* x (the long-float (expt 10.0l0 (- ex)))) - while (<= y 0.1l0) + while (< y 0.1l0) do (decf ex) finally (return (values y (the fixnum (+ delta ex))))) (loop for y of-type long-float = (/ x (the long-float (expt 10.0l0 ex))) - while (> y 1.0l0) + while (>= y 1.0l0) do (incf ex) finally (return (values y (the fixnum (+ delta ex))))))) #+(or) @@ -1471,9 +1471,8 @@ (prin1 number stream) (multiple-value-bind (num expt) (sys::scale-exponent (abs number)) - (when (< expt 0) + (when (< expt 0) ; adjust scale factor (decf k)) - ;; (incf expt)) (let* ((expt (- expt k)) (estr (decimal-string (abs expt))) (elen (if e (max (length estr) e) (length estr))) From 983f36d3f54b445962a5f329b6d7eefd69a69865 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 15:07:18 +0200 Subject: [PATCH 29/30] changelog: update information. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG b/CHANGELOG index df742d52b..a8e276999 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -40,7 +40,7 @@ - Improved unicode support in character handling. - - Format handles floats correctly (algorithm rework). + - Format handles floats and exponentials correctly (major format rework). ** Enchantments: From 827d3035bc8739f2fc83041815ad7873b5411b48 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 12 May 2015 15:09:26 +0200 Subject: [PATCH 30/30] buildsystem: tests: fix test urls to use http. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Daniel Kochmański --- src/tests/config.lsp.in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tests/config.lsp.in b/src/tests/config.lsp.in index 53fce9aa8..09dd6f38b 100755 --- a/src/tests/config.lsp.in +++ b/src/tests/config.lsp.in @@ -58,19 +58,19 @@ (defvar *regressions-sandbox* (merge-pathnames "regressions/" *here*)) -(defvar *ansi-tests-mirror* "https://common-lisp.net/project/ecl/tests/ansi-tests.tar.gz") +(defvar *ansi-tests-mirror* "http://common-lisp.net/project/ecl/tests/ansi-tests.tar.gz") (defvar *ansi-tests-sandbox* (merge-pathnames "ansi-tests/" *here*)) (defvar *ansi-tests-tarball* "ansi-tests.tar.gz") -(defvar *mop-tests-mirror* "https://common-lisp.net/project/ecl/tests/mop-features.tar.gz") +(defvar *mop-tests-mirror* "http://common-lisp.net/project/ecl/tests/mop-features.tar.gz") (defvar *mop-tests-sandbox* (merge-pathnames "mop-features/" *here*)) (defvar *mop-tests-tarball* "mop-features.tar.gz") -(defvar *fricas-mirror* "https://common-lisp.net/project/ecl/tests/fricas.tar.gz") +(defvar *fricas-mirror* "http://common-lisp.net/project/ecl/tests/fricas.tar.gz") (defvar *fricas-sandbox* (merge-pathnames "fricas/" *here*))