Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 0a9c9c7c by Raymond Toy at 2026-05-28T07:23:00-07:00 Round ~F to width when d is unspecified `format-f-free` emitted the un-rounded shortest form when it didn't fit in the field width of w. Add `emit-rounded-to-width`: round to the fractional digits that fit, always showing at least one (CLHS 22.3.3.1), dropping the leading zero to fit. Fixes ansi-tests FORMAT.F.45 and F.47. Tests in ryu.lisp also updated because they erroneously used the un-rounded result instead of one that fits in the specified width. - - - - - 3 changed files: - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot - tests/ryu.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -491,24 +491,79 @@ (int-len (max 1 (1+ exponent))) (shortest-d (max 0 (- digit-count 1 exponent))) (sign-len (if (or is-negative-p at-sign-p) 1 0)) - (d-fit (and w (- w sign-len int-len 1)))) + (d-fit (and w (- w sign-len int-len 1))) + ;; When the magnitude is < 1 the integer part is a single + ;; "0" that may be dropped (the leading zero is optional), + ;; freeing one more slot for a fractional digit. Compute + ;; the fractional-digit count that exactly fills W under + ;; that rule. + (frac-fit (and w + (if (plusp (1+ exponent)) + (- w sign-len int-len 1) ; "[int]." + (- w sign-len 1))))) ; ".[frac]" (cond ((or (null w) (>= d-fit shortest-d)) - ;; No width or the shortest form fits within a field width - ;; of W. + ;; No width, or the shortest round-trip form already fits + ;; within a field width of W. Emit it directly. (emit-shortest stream mantissa exponent is-negative-p w overflowchar padchar at-sign-p)) - (overflowchar - ;; Shortest form does not fit and OVERFLOWCHAR is set; fill - ;; the field with overflow characters. + ((and overflowchar (minusp frac-fit)) + ;; Not even the integer part and decimal point fit, and an + ;; overflow character was supplied: fill the field. (loop repeat w do (write-char overflowchar stream))) (t - ;; Shortest form does not fit and no OVERFLOWCHAR; emit the - ;; full shortest form, letting the field expand. CLHS - ;; 22.3.3.1 requires this. - (emit-shortest stream mantissa exponent is-negative-p w - overflowchar padchar at-sign-p))))))) + ;; The shortest form does not fit in W. D was not specified, + ;; so round the value to the largest number of fractional + ;; digits FRAC-FIT that fits, then display it. Per CLHS + ;; 22.3.3.1, if the fraction rounds away to nothing a single + ;; zero digit must still appear after the decimal point. We + ;; therefore round at FRAC-FIT places (which may be 0) but + ;; always show at least one fractional digit. + (emit-rounded-to-width stream value (max 0 frac-fit) + is-negative-p w + overflowchar padchar at-sign-p))))))) + +(defun emit-rounded-to-width (stream value frac is-negative-p w + overflowchar padchar at-sign-p) + "Round (the magnitude of) VALUE to FRAC fractional digits with + d2fixed and write it right-justified in a field of width W. At + least one fractional digit is always shown: if FRAC is 0 the + rounded value is integral and a single \"0\" is appended after the + decimal point (CLHS 22.3.3.1). The optional leading zero before + the decimal point is dropped when the field would otherwise + overflow W. Used by the free-format ~F path when the shortest + representation does not fit in W." + (declare (type (or single-float double-float) value) + (type (integer 0 *) frac)) + (let* ((rounded (d2fixed (float (abs value) 1d0) frac)) + ;; ROUNDED is "ddd" (frac=0) or "ddd.ddd" (frac>0). Split it + ;; into integer and fractional digit runs. + (dot (position #\. rounded)) + (int-part (if dot (subseq rounded 0 dot) rounded)) + (frac-part (if dot (subseq rounded (1+ dot)) "")) + ;; Force at least one fractional digit. + (frac-out (if (zerop (length frac-part)) "0" frac-part)) + (sign-len (if (or is-negative-p at-sign-p) 1 0)) + ;; The leading "0." may be shortened to "." when the magnitude + ;; is < 1 (integer part is a single "0") and nonzero, and the + ;; full field would not fit in W. + (lpoint-droppable + (and (string= int-part "0") + (not (zerop value)))) + (full-len (+ sign-len (length int-part) 1 (length frac-out))) + (drop-leading-zero-p + (and lpoint-droppable w (> full-len w))) + (field-len (if drop-leading-zero-p (1- full-len) full-len))) + (flet ((write-field () + (cond (is-negative-p (write-char #\- stream)) + (at-sign-p (write-char #\+ stream))) + (unless drop-leading-zero-p + (write-string int-part stream)) + (write-char #\. stream) + (write-string frac-out stream))) + (declare (dynamic-extent #'write-field)) + (pad-overflow stream field-len w overflowchar padchar #'write-field)))) (defun format-f (value w d k overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7477,6 +7477,18 @@ msgid "" " the double-float absolute value of VALUE." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Round (the magnitude of) VALUE to FRAC fractional digits with\n" +" d2fixed and write it right-justified in a field of width W. At\n" +" least one fractional digit is always shown: if FRAC is 0 the\n" +" rounded value is integral and a single \"0\" is appended after the\n" +" decimal point (CLHS 22.3.3.1). The optional leading zero before\n" +" the decimal point is dropped when the field would otherwise\n" +" overflow W. Used by the free-format ~F path when the shortest\n" +" representation does not fit in W." +msgstr "" + #: src/code/print.lisp msgid "" "If true, all objects will printed readably. If readably printing is\n" ===================================== tests/ryu.lisp ===================================== @@ -367,20 +367,17 @@ (assert-equal " 1.0" (lisp::format-f 1d0 10 nil 0 nil nil nil))) -(define-test format-f.d-nil-with-w-no-shrink +(define-test format-f.d-nil-with-w-shrinks (:tag :format-f) - ;; CLHS 22.3.3.1: when d is unspecified, the digit count is set so - ;; that the result reads back as an EQUAL float, with no extraneous - ;; trailing zeros. This is the round-trip count. When the result - ;; does not fit in w and no overflowchar is supplied, the field - ;; expands -- it does NOT shrink the digits, because doing so would - ;; produce a different float on read-back. (Earlier ryu code did - ;; shrink here; that change was needed to pass ANSI FORMAT.F.5.) - (assert-equal "1.234567" + ;; d=nil with a tight width: CL rounds the value to the largest + ;; number of fractional digits that fits in W (matching the B&D + ;; reference output). 3.141592653589793 shrinks to fit; 1.234567 + ;; with w=6 rounds to "1.2346". + (assert-equal "1.2346" (lisp::format-f 1.234567d0 6 nil 0 nil nil nil)) - (assert-equal "3.141592653589793" + (assert-equal "3.14159265" (lisp::format-f 3.141592653589793d0 10 nil 0 nil nil nil)) - (assert-equal "3.141592653589793" + (assert-equal "3.141593" (lisp::format-f 3.141592653589793d0 8 nil 0 nil nil nil))) (define-test format-f.d-nil-with-w-overflow @@ -755,10 +752,11 @@ (define-test format-f.single-narrow-width-no-overflow-char (:tag :format-f :single-float) - ;; CLHS 22.3.3.1: when the shortest form does not fit in the - ;; specified width and no overflow character is supplied, the field - ;; expands rather than truncating digits. Round-trip and the - ;; "at least one digit after the decimal point" rule must both hold. + ;; ~F with unspecified d and a width too small for the shortest form: + ;; the value is rounded to the fractional digits that fit, but at + ;; least one fractional digit is always shown (CLHS 22.3.3.1). With + ;; no overflow char the field expands when even that minimum + ;; doesn't fit. 1.0 -> "1.0". (assert-equal "1.0" (lisp::format-f 1.0f0 2 nil 0 nil nil nil)) (assert-equal "1.0" @@ -767,6 +765,21 @@ (assert-equal "1.0" (lisp::format-f 1.0d0 2 nil 0 nil nil nil))) +(define-test format-f.d-nil-rounds-to-width-with-forced-zero + (:tag :format-f) + ;; ANSI FORMAT.F.45/F.47: ~F with unspecified d rounds the value to + ;; the fractional digits that fit in W, but always shows at least one + ;; fractional digit (a single "0" if the fraction rounds away). The + ;; field expands past W when even that minimum doesn't fit and no + ;; overflow char is given. + ;; ~2f of 1.1 and 1.9 round to integers, forced ".0", overflow to 3. + (assert-equal "1.0" (lisp::format-f 1.1f0 2 nil 0 nil nil nil)) + (assert-equal "2.0" (lisp::format-f 1.9f0 2 nil 0 nil nil nil)) + ;; ~3f of 1e-6: rounds to .00 (leading zero dropped to fit width 3). + (assert-equal ".00" (lisp::format-f 1.0f-6 3 nil 0 nil nil nil)) + ;; ~4f of 1e-6: .000. + (assert-equal ".000" (lisp::format-f 1.0f-6 4 nil 0 nil nil nil))) + (define-test format-f.single-narrow-width-with-overflow-char (:tag :format-f :single-float) ;; With overflowchar supplied, the field is filled with the overflow View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0a9c9c7c673cc6f9342ae9a7... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0a9c9c7c673cc6f9342ae9a7... 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