Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 21d82127 by Raymond Toy at 2026-05-28T17:12:00-07:00 Drop fractional digit in ~E d-specified when k consumes it CLHS 22.3.3.2: with D specified, the number of fractional digits is exactly d-(k-1). When k >= d+1 (and k >= 2) that count is 0, and the output is "[int].e[exp]" with no forced ".0". Bypass scale-mantissa for this case. k=1, d=0 keeps the legacy "D.0eN" behavior cmucl has always produced. Factor the inline emit added in c841c128d for the d=nil tight-width path into a shared helper emit-exp-no-fraction that handles sign-and-pad via pad-overflow. Update format-e.overflow-no-overflowchar and -shrink-exhausts expected values: they were pinning the pre-c841c128d behavior of emitting the full multi-digit shortest form on overflow; the ansi-correct behavior is now the no-fractional-digit form. Fixes ansi-test FORMAT.E.19. - - - - - 3 changed files: - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot - tests/ryu.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -358,6 +358,54 @@ (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) +(defun emit-exp-no-fraction (stream mantissa shown-exp int-digits + is-negative-p at-sign-p + w e overflowchar padchar exponentchar) + "Emit \"[sign][INT-DIGITS].[marker][exp-sign][exp]\" with no + fractional digits, right-justified in width W. MANTISSA is a + string of significant digits from d2s/d2exp, with or without an + internal dot; the integer digits are written from it (skipping the + dot if any), zero-padded to INT-DIGITS." + (declare (type simple-string mantissa) + (fixnum shown-exp int-digits) + (type (or null fixnum) w e)) + (let* ((dotpos (position #\. mantissa)) + (mant-len (length mantissa)) + (sig-digits (mantissa-digit-count mantissa)) + (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)) + (sign-len (if (or is-negative-p at-sign-p) 1 0)) + ;; sign + int + dot + marker + exp-sign + exp-width + (field-len (+ sign-len int-digits 3 exp-width))) + (flet ((write-field () + (cond (is-negative-p (write-char #\- stream)) + (at-sign-p (write-char #\+ stream))) + ;; Write up to sig-digits from mantissa (skipping the dot), + ;; then zero-pad if int-digits exceeds available. + (let ((available (min int-digits sig-digits))) + (cond ((null dotpos) + (write-string mantissa stream :start 0 :end available)) + ((<= available dotpos) + (write-string mantissa stream :start 0 :end available)) + (t + (write-string mantissa stream :start 0 :end dotpos) + (write-string mantissa stream + :start (1+ dotpos) + :end (min mant-len (1+ available)))))) + (loop repeat (- int-digits sig-digits) + do (write-char #\0 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))) + (declare (dynamic-extent #'write-field)) + (pad-overflow stream field-len w overflowchar padchar #'write-field)))) + (defun format-e (value w d e k overflowchar padchar exponentchar at-sign-p) (declare (type (or single-float double-float) value) (fixnum k) @@ -371,8 +419,22 @@ (multiple-value-bind (mantissa exponent) (parsed-exp-form (d2exp abs-value (d2exp-precision d k))) - (format-e-string stream mantissa exponent is-negative-p - w e k overflowchar padchar exponentchar at-sign-p nil))) + (cond + ;; CLHS 22.3.3.2: with D specified, exactly d-(k-1) + ;; fractional digits appear after the dot. When that is 0 + ;; (k >= d+1, plusp k), emit "[int].e[exp]" directly with + ;; no forced ".0" -- the d2exp result has been rounded to + ;; exactly the digits we need to show. The k=1, d=0 case + ;; is excluded: cmucl has always emitted "D.0eN" there and + ;; existing tests rely on it. + ((and (>= k 2) (>= k (1+ d))) + (emit-exp-no-fraction stream mantissa + (- exponent (1- k)) + k is-negative-p at-sign-p + w e overflowchar padchar exponentchar)) + (t + (format-e-string stream mantissa exponent is-negative-p + w e k overflowchar padchar exponentchar at-sign-p nil))))) (t (multiple-value-bind (mantissa exponent) (parsed-exp-form (float-to-string value)) @@ -410,20 +472,10 @@ ;; 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)))) + (emit-exp-no-fraction stream one-digit shown-exp 1 + is-negative-p at-sign-p + w e overflowchar padchar + exponentchar))) (t ;; k != 1 and no width fits: fall back to the ;; shortest form (may still emit a forced ".0"; ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7484,6 +7484,15 @@ msgid "" " the double-float absolute value of VALUE." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Emit \"[sign][INT-DIGITS].[marker][exp-sign][exp]\" with no\n" +" fractional digits, right-justified in width W. MANTISSA is a\n" +" string of significant digits from d2s/d2exp, with or without an\n" +" internal dot; the integer digits are written from it (skipping the\n" +" dot if any), zero-padded to INT-DIGITS." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Round (the magnitude of) VALUE to FRAC fractional digits with\n" ===================================== tests/ryu.lisp ===================================== @@ -200,12 +200,15 @@ (define-test format-e.overflow-no-overflowchar (:tag :format-e) - ;; w too small AND no overflowchar -- emit the field at natural - ;; width, exceeding w. No truncation. - (assert-equal "3.14d+100" + ;; w too small AND no overflowchar -- emit the no-fractional-digit + ;; form "d.e+exp" (overflowing W), per CLHS 22.3.3.2 "single zero + ;; digit ... if the width w permits" (here it does not). + (assert-equal "3.d+100" (lisp::format-e 3.14d100 3 nil nil 1 nil nil #\d nil)) - ;; Free-format too long for w with no overflowchar. - (assert-equal "3.14159265358979d+0" + ;; Free-format too long for w with no overflowchar -- same rule: + ;; drop to no-fractional-digit form rather than emitting the full + ;; multi-digit shortest representation. + (assert-equal "3.d+0" (lisp::format-e 3.14159265358979d0 5 nil nil 1 nil nil #\d nil))) (define-test format-e.overflow-exponent-too-wide @@ -232,12 +235,14 @@ (define-test format-e.overflow-shrink-exhausts (:tag :format-e) - ;; w forces shrinking down to d_fit = 0, which still won't fit. - ;; Should produce overflow fill. + ;; w forces shrinking down to d_fit = nil (not even d=0 fits). + ;; With an overflow char, the field is filled. (assert-equal "****" (lisp::format-e 3.14159265358979d0 4 nil nil 1 #\* nil #\d nil)) - ;; Same but no overflowchar -- emit at natural shortest width. - (assert-equal "3.14159265358979d+0" + ;; Without overflowchar, emit the no-fractional-digit form + ;; "d.e+exp" (overflowing W) rather than the full multi-digit + ;; shortest representation. + (assert-equal "3.d+0" (lisp::format-e 3.14159265358979d0 4 nil nil 1 nil nil #\d nil))) (define-test format-e.overflow-with-padchar @@ -306,6 +311,24 @@ (assert-equal "-1.e+0" (lisp::format-e -1.0f0 6 nil nil 1 nil nil #\e nil))) +(define-test format-e.d-given-k-consumes-fraction + (:tag :format-e) + ;; ANSI FORMAT.E.19: with D specified, the number of fractional + ;; digits is exactly d-(k-1). When k >= d+1 (and k >= 2) that count + ;; is 0, and the output is "[int].e[exp]" with no forced ".0". + ;; d=2, k=3, value 0.05 -> "5.00E-2" rounded by d2exp -> "500.e-4" + ;; after the k-shift consumes the fractional digits. + (assert-equal "500.e-4" + (lisp::format-e 0.05f0 nil 2 nil 3 nil nil #\e nil)) + (assert-equal "500.e-4" + (lisp::format-e 0.05d0 nil 2 nil 3 nil nil #\e nil)) + ;; Negated: leading "-" sign included. + (assert-equal "-500.e-4" + (lisp::format-e -0.05d0 nil 2 nil 3 nil nil #\e nil)) + ;; At-sign: explicit "+". + (assert-equal "+500.e-4" + (lisp::format-e 0.05d0 nil 2 nil 3 nil nil #\e t))) + ;;; ~F tests (define-test format-f.basic (:tag :format-f) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/21d82127a595a016ea6e4f2e... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/21d82127a595a016ea6e4f2e... 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