Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: c841c128 by Raymond Toy at 2026-05-28T15:31:14-07:00 Drop fractional digit in ~E d=nil when width too tight When the ~E determines that even "d.0e+exp" does not fit W, ryu was falling back to `format-e-string` with the original mantissa, which forces a ".0" via scale-mantissa. Per CLHS 22.3.3.2, the "single zero digit" only appears if width permits; otherwise the fractional digit is dropped and the field expands to "d.e+exp". Handled only for k=1; other k values keep the old fallback. While here, replace `(length (princ-to-string ...))` in `compute-d-for-width` with count-decimal-digits, dropping its consing from 1008 B/call to 8 B/call on this path. Fixes ansi-tests FORMAT.E.4, FORMAT.E.5, FORMAT.E.7, FORMAT.E.8, FORMAT.E.9, and their FORMATTER.* counterparts. - - - - - 2 changed files: - src/code/ryu-print.lisp - tests/ryu.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -142,7 +142,7 @@ (declare (fixnum k actual-exp)) (let* ((sign-len (if (or is-negative-p at-sign-p) 1 0)) (exp-digits (max (or e 1) - (length (princ-to-string (abs actual-exp))))) + (count-decimal-digits (abs actual-exp)))) ;; The min output includes the leading sign, and the length ;; of the exponent. If k > 0, we have a leading digit, a ;; dot, the exponent marker and exponent sign for 4 extra. @@ -389,16 +389,48 @@ (t (let* ((d-fit (compute-d-for-width w e k actual-exp is-negative-p at-sign-p)) (drop-zero-p (and d-fit (<= k 0)))) - (if d-fit - (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2exp abs-value + (cond + (d-fit + (multiple-value-bind (mantissa exponent) + (parsed-exp-form (d2exp abs-value (d2exp-precision d-fit k))) - (format-e-string stream mantissa exponent is-negative-p - w e k overflowchar padchar exponentchar at-sign-p - drop-zero-p)) - (format-e-string stream mantissa exponent is-negative-p - w e k overflowchar padchar exponentchar at-sign-p - nil)))))))))))) + (format-e-string stream mantissa exponent is-negative-p + w e k overflowchar padchar exponentchar at-sign-p + drop-zero-p))) + (overflowchar + ;; Not even the no-fractional-digit form fits and + ;; an overflow char was supplied: fill W. + (loop repeat w do (write-char overflowchar stream))) + ((= k 1) + ;; No fractional digit fits. Emit "[d].e[exp]" + ;; directly -- no forced ".0". CLHS 22.3.3.2 + ;; "single zero digit ... if the width w permits"; + ;; here it does not, so the field overflows W. + ;; Handled only for k=1 (default); other k values + ;; fall through to the old format-e-string path. + (multiple-value-bind (one-digit shown-exp) + (parsed-exp-form (d2exp abs-value 0)) + (let* ((exp-sign (if (minusp shown-exp) #\- #\+)) + (exp-abs (abs shown-exp)) + (exp-digits (count-decimal-digits exp-abs)) + (exp-width (max (or e 1) exp-digits)) + (exp-marker (or exponentchar #\d))) + (cond (is-negative-p (write-char #\- stream)) + (at-sign-p (write-char #\+ stream))) + (write-string one-digit stream) + (write-char #\. stream) + (write-char exp-marker stream) + (write-char exp-sign stream) + (loop repeat (- exp-width exp-digits) + do (write-char #\0 stream)) + (princ exp-abs stream)))) + (t + ;; k != 1 and no width fits: fall back to the + ;; shortest form (may still emit a forced ".0"; + ;; rare, not yet handled). + (format-e-string stream mantissa exponent is-negative-p + w e k overflowchar padchar exponentchar at-sign-p + nil))))))))))))) ;;; Ryu ~F (defun format-f-fixed (stream value w d ===================================== tests/ryu.lisp ===================================== @@ -288,6 +288,24 @@ (assert-equal "0.0d+0" (lisp::format-e 0d0 nil nil nil 1 nil nil #\d nil))) +(define-test format-e.tight-width-no-fraction + (:tag :format-e) + ;; ANSI FORMAT.E.4/.5/.7/.8/.9: ~Ne with N too small for the + ;; "d.0e+0" shortest form drops the fractional digit instead of + ;; forcing the ".0", giving "d.e+0" (overflowing W when even that + ;; form is wider). CLHS 22.3.3.2 "single zero digit ... if the + ;; width w permits" -- here it does not. + (assert-equal "1.e+0" + (lisp::format-e 1.0f0 5 nil nil 1 nil nil #\e nil)) + (assert-equal "1.e+0" + (lisp::format-e 1.0f0 4 nil nil 1 nil nil #\e nil)) + (assert-equal "+1.e+0" + (lisp::format-e 1.0f0 6 nil nil 1 nil nil #\e t)) + (assert-equal "+1.e+0" + (lisp::format-e 1.0f0 5 nil nil 1 nil nil #\e t)) + (assert-equal "-1.e+0" + (lisp::format-e -1.0f0 6 nil nil 1 nil nil #\e nil))) + ;;; ~F tests (define-test format-f.basic (:tag :format-f) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c841c128d7b018e4ff0b49fc... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c841c128d7b018e4ff0b49fc... You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications: https://gitlab.common-lisp.net/-/profile/notifications | Help: https://gitlab.common-lisp.net/help