- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new branch issue-508-ansi-test-log-artifact-on-failure
by Raymond Toy (＠rtoy) 31 May '26

31 May '26

Raymond Toy pushed new branch issue-508-ansi-test-log-artifact-on-failure at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-508-ansi-test-log-a… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Fix typos in def-format-ryu
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 059bf9a8 by Raymond Toy at 2026-05-29T16:46:57-07:00 Fix typos in def-format-ryu Forgot a comma and `(values)` was in the wrong place. - - - - - 1 changed file: - src/code/format.lisp Changes: ===================================== src/code/format.lisp ===================================== @@ -1583,10 +1583,10 @@ ((and (floatp ,number) (or (float-infinity-p ,number) (float-nan-p ,number))) - (prin1 number ,stream)) + (prin1 ,number ,stream)) (t - ,@forms) - (values))))) + ,@forms)) + (values)))) (defmacro def-format-aux (base-name (stream number &rest args) &body body) (let ((docstring View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/059bf9a81579243ffb7a5be… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/059bf9a81579243ffb7a5be… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] 3 commits: Fix a few typos in format-fixed-ryu
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 7efabb20 by Raymond Toy at 2026-05-29T14:02:59-07:00 Fix a few typos in format-fixed-ryu Stray "stream" after the format-f sexp and extra nil at the end of the first cond clause. - - - - - a519742d by Raymond Toy at 2026-05-29T14:45:23-07:00 Add macro def-format-ryu to handle ryu functions The functions format-fixed-ryu, format-exp-ryu, and format-general-ryu all look the same except for the ryu function that is called. Therefore, add a macro that can be used to define all of these functions. And make lisp::format-f handle the case of non-zero k by calling format::format-fixed-aux-bd directly. Then the check for non-zero k in format-fixed-aux can be elided. This makes all the format-foo-aux look similar. - - - - - 05b7706f by Raymond Toy at 2026-05-29T16:42:20-07:00 Macroize all the format-foo-aux functions The functions `format-{fixed,exp,general}-aux` are all basically the same except for then names of the functions that are called for the ryu printer and the B&D printer. Create a macro to abstract this out by taking the base name and created the appropriate functions names that are called. - - - - - 3 changed files: - src/code/format.lisp - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/format.lisp ===================================== @@ -1572,35 +1572,48 @@ (format-princ stream number nil nil w 1 0 pad))) +(defmacro def-format-ryu (name (stream number &rest args) &body body) + (multiple-value-bind (docstring forms) + (if (and (stringp (first body)) (rest body)) + (values (list (first body)) (rest body)) + (values nil body)) + `(defun ,name (,stream ,number ,@args) + ,@docstring + (cond + ((and (floatp ,number) + (or (float-infinity-p ,number) + (float-nan-p ,number))) + (prin1 number ,stream)) + (t + ,@forms) + (values))))) + +(defmacro def-format-aux (base-name (stream number &rest args) &body body) + (let ((docstring + (if (and (stringp (first body)) (rest body)) + (list (first body)) + nil))) + (let ((defun-name (symbolicate base-name "-AUX")) + (name-ryu (symbolicate base-name "-RYU")) + (name-bd (symbolicate base-name "-AUX-BD"))) + `(defun ,defun-name (,stream ,number ,@args) + ,@docstring + (cond + ((and lisp::*use-ryu-printer* + (typep ,number '(or single-float double-float))) + (,name-ryu ,stream ,number ,@args)) + (t + (,name-bd ,stream, number ,@args))))))) + ;;; We return true if we overflowed, so that ~G can output the overflow char ;;; instead of spaces. ;;; -(defun format-fixed-aux (stream number w d k ovf pad atsign) - (declare (type float number)) - ;; Dispatch to either the Burger and Dybvig implementation or the - ;; Ryu-based implementation. The Ryu code only handles single- and - ;; double-float values, so any other float type (notably - ;; DOUBLE-DOUBLE-FLOAT) always falls through to the B&D path. - (cond - ((and lisp::*use-ryu-printer* - (or (null k) (zerop k)) - (typep number '(or single-float double-float))) - (format-fixed-ryu stream number w d k ovf pad atsign)) - (t - (format-fixed-aux-bd stream number w d k ovf pad atsign)))) - -(defun format-fixed-ryu (stream number w d k ovf pad atsign) +(def-format-aux format-fixed (stream number w d k ovf pad atsign)) + +(def-format-ryu format-fixed-ryu (stream number w d k ovf pad atsign) "Ryu-based implementation of the ~F directive. Delegates to LISP::FORMAT-F, which returns the formatted field as a string." - (cond - ((and (floatp number) - (or (float-infinity-p number) - (float-nan-p number))) - (prin1 number stream) - nil) - (t - (lisp::format-f stream number w d (or k 0) ovf pad atsign) stream))) - nil) + (lisp::format-f stream number w d (or k 0) ovf pad atsign)) (defun format-fixed-aux-bd (stream number w d k ovf pad atsign) "Burger and Dybvig based implementation of the ~F directive." @@ -1884,40 +1897,19 @@ (write-string estr stream)))))))) (values)) -(defun format-exp-ryu (stream number w d e k ovf pad marker atsign) +(def-format-ryu format-exp-ryu (stream number w d e k ovf pad marker atsign) "Ryu-based implementation of the ~E directive. Delegates to LISP::FORMAT-E, which returns the formatted field as a string." - (cond - ((and (floatp number) - (or (float-infinity-p number) - (float-nan-p number))) - (prin1 number stream)) - (t - ;; LISP::FORMAT-E uses a literal #\d as the default exponent - ;; marker when EXPONENTCHAR is NIL, but the CL ~E directive - ;; chooses the marker based on the value's type and - ;; *READ-DEFAULT-FLOAT-FORMAT* (see FORMAT-EXPONENT-MARKER). - ;; Resolve the default here so the same rule applies. - (lisp::format-e stream number w d e k ovf pad - (or marker (format-exponent-marker number)) - atsign))) - (values)) - -(defun format-exp-aux (stream number w d e k ovf pad marker atsign) - ;; Dispatch to either the Burger and Dybvig implementation or the - ;; Ryu-based implementation. The Ryu code only handles single- and - ;; double-float values, so any other float type (notably - ;; DOUBLE-DOUBLE-FLOAT) always falls through to the B&D path. - (cond - ((and lisp::*use-ryu-printer* - (floatp number) - (typep number '(or single-float double-float)) - (not (or (float-infinity-p number) - (float-nan-p number)))) - (format-exp-ryu stream number w d e k ovf pad marker atsign)) - (t - (format-exp-aux-bd stream number w d e k ovf pad marker atsign)))) + ;; LISP::FORMAT-E uses a literal #\d as the default exponent + ;; marker when EXPONENTCHAR is NIL, but the CL ~E directive + ;; chooses the marker based on the value's type and + ;; *READ-DEFAULT-FLOAT-FORMAT* (see FORMAT-EXPONENT-MARKER). + ;; Resolve the default here so the same rule applies. + (lisp::format-e stream number w d e k ovf pad + (or marker (format-exponent-marker number)) + atsign)) +(def-format-aux format-exp (stream number w d e k ovf pad marker atsign)) (def-format-directive #\G (colonp atsignp params) (when colonp @@ -1954,33 +1946,14 @@ ;;; toy(a)rtp.ericsson.se: Same change as for format-exp-aux. -(defun format-general-aux (stream number w d e k ovf pad marker atsign) - ;; Dispatch to either the Burger and Dybvig implementation or the - ;; Ryu-based implementation. The Ryu code only handles single- and - ;; double-float values, so any other float type (notably - ;; DOUBLE-DOUBLE-FLOAT) always falls through to the B&D path. - (cond - ((and lisp::*use-ryu-printer* - (floatp number) - (typep number '(or single-float double-float))) - (format-general-ryu stream number w d e k ovf pad marker atsign)) - (t - (format-general-aux-bd stream number w d e k ovf pad marker atsign)))) - -(defun format-general-ryu (stream number w d e k ovf pad marker atsign) +(def-format-aux format-general (stream number w d e k ovf pad marker atsign)) + +(def-format-ryu format-general-ryu (stream number w d e k ovf pad marker atsign) "Ryu-based implementation of the ~G directive. Delegates to LISP::FORMAT-G, which returns the formatted field as a string." - (cond - ((and (floatp number) - (or (float-infinity-p number) - (float-nan-p number))) - (prin1 number stream) - nil) - (t - (lisp::format-g stream number w d e (or k 1) ovf pad - (or marker (format-exponent-marker number)) - atsign))) - (values)) + (lisp::format-g stream number w d e (or k 1) ovf pad + (or marker (format-exponent-marker number)) + atsign)) (defun format-general-aux-bd (stream number w d e k ovf pad marker atsign) "Burger and Dybvig based implementation of the ~G directive." ===================================== src/code/ryu-print.lisp ===================================== @@ -635,13 +635,13 @@ (declare (type (or single-float double-float) value) (fixnum k) (type (or null (and unsigned-byte fixnum)) w d)) - (cond ((not (zerop k)) - ;; Complex case that doesn't fit with what d2s and d2fixed - ;; returns. Especially when d+k is negative so that some - ;; digits are shifted right past the desired precision. - ;; We'd have to round the result. Just use our existing - ;; code to handle this case with the correct rounding. - (format::format-fixed-aux stream value w d k overflowchar padchar at-sign-p)) + (cond ((and k (not (zerop k))) + ;; Complex case that doesn't fit with what d2s and d2fixed + ;; returns. Especially when d+k is negative so that some + ;; digits are shifted right past the desired precision. We'd + ;; have to round the result. Just use our existing code to + ;; handle this case with the correct rounding. + (format::format-fixed-aux-bd stream value w d k overflowchar padchar at-sign-p)) (d (format-f-fixed stream value w d overflowchar padchar at-sign-p)) (t ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7487,6 +7487,13 @@ msgid "" " double-float's exponent, so 0 <= n <= 324." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Number of decimal digits needed to display the ACTUAL-EXP in a width\n" +" of E. If E is NIL, the actual number of digits is returned.\n" +" Otherwise, the max of E and the number of digits is returned." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Find the largest d (precision) value that fits in width W given the\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7fbbfafe00b19036c820df… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7fbbfafe00b19036c820df… 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

1 0

[Git][cmucl/cmucl] Pushed new branch issue-506-add-ryu-printf
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed new branch issue-506-add-ryu-printf at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-506-add-ryu-printf 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Factor out common code for exponent digits
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 7fbbfafe by Raymond Toy at 2026-05-29T10:32:11-07:00 Factor out common code for exponent digits Add new function `exponent-digit-count` that computes the number of digits needed for an exponent. Use this in the two locations where this is needed. Update cmucl.pot for new docstrings. - - - - - 2 changed files: - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -147,6 +147,16 @@ ((< n 100) 2) (t 3))) +(declaim (inline exponent-digit-count)) +(defun exponent-digit-count (e actual-exp) + "Number of decimal digits needed to display the ACTUAL-EXP in a width + of E. If E is NIL, the actual number of digits is returned. + Otherwise, the max of E and the number of digits is returned." + (declare (type (or fixnum null) e) + (fixnum actual-exp)) + (max (or e 1) + (count-decimal-digits (abs actual-exp)))) + (defun compute-d-for-width (w e k actual-exp is-negative-p at-sign-p) "Find the largest d (precision) value that fits in width W given the actual exponent (adjusted by k), and whether signs are printed or @@ -155,8 +165,7 @@ Returns NIL if no width d can fit in a field of length w." (declare (fixnum k actual-exp)) (let* ((sign-len (if (or is-negative-p at-sign-p) 1 0)) - (exp-digits (max (or e 1) - (count-decimal-digits (abs actual-exp)))) + (exp-digits (exponent-digit-count e 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. @@ -187,8 +196,7 @@ (fixnum actual-exp k) (type (or null fixnum) e)) (let* ((sign-len (if (or is-negative-p at-sign-p) 1 0)) - (exp-digits (max (or e 1) - (count-decimal-digits (abs actual-exp)))) + (exp-digits (exponent-digit-count e actual-exp)) (raw-digits (mantissa-digit-count mantissa)) (mantissa-len (cond @@ -328,6 +336,21 @@ ;; d - |k| - 1 digits after the decimal point. (max (+ d k -1) 0)))) +(defun write-exponent (stream shown-exp e exponentchar) + "Write the ~E exponent tail \"[marker][sign][digits]\" to STREAM. + E is the minimum exponent-digit count (zero-padded if shorter); + EXPONENTCHAR overrides the marker (default #\\d)." + (declare (fixnum shown-exp) + (type (or null fixnum) e)) + (let* ((exp-abs (abs shown-exp)) + (exp-digits (count-decimal-digits exp-abs)) + (exp-width (max (or e 1) exp-digits))) + (write-char (or exponentchar #\d) stream) + (write-char (if (minusp shown-exp) #\- #\+) stream) + (loop repeat (- exp-width exp-digits) + do (write-char #\0 stream)) + (princ exp-abs stream))) + (defun format-e-string (stream mantissa exponent is-negative-p w e k overflowchar padchar exponentchar at-sign-p drop-leading-zero-p) @@ -342,32 +365,14 @@ (declare (type simple-string mantissa) (fixnum exponent k)) (let* ((shown-exp (- exponent (1- k))) - (exp-sign (if (minusp shown-exp) - #\- #\+)) - (exp-abs (abs shown-exp)) - (exp-marker (or exponentchar #\d)) - (exp-digits (count-decimal-digits exp-abs)) - (exp-width (max (or e 1) - exp-digits)) - ;; Full output length: sign + reshaped + marker + exp-sign + - ;; exp-width. compute-exp-output-length gives reshape + exp - ;; body (marker + exp-sign + max(e, exp-digits)), but it also - ;; includes sign, so use it directly. Wait, it doesn't - ;; account for drop-leading-zero, so we use it carefully. (field-len (compute-exp-output-length mantissa shown-exp k e is-negative-p at-sign-p drop-leading-zero-p))) (flet ((write-field () - (cond (is-negative-p - (write-char #\- stream)) - (at-sign-p - (write-char #\+ stream))) + (cond (is-negative-p (write-char #\- stream)) + (at-sign-p (write-char #\+ stream))) (scale-mantissa stream mantissa k drop-leading-zero-p) - (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))) + (write-exponent stream shown-exp e exponentchar))) (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) @@ -385,11 +390,7 @@ (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)) + (exp-width (exponent-digit-count e shown-exp)) (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))) @@ -411,11 +412,7 @@ (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))) + (write-exponent stream shown-exp e exponentchar))) (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7533,6 +7533,13 @@ msgid "" " scale factor is K." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Write the ~E exponent tail \"[marker][sign][digits]\" to STREAM.\n" +" E is the minimum exponent-digit count (zero-padded if shorter);\n" +" EXPONENTCHAR overrides the marker (default #\\d)." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Write the ~E representation of MANTISSA * 10^EXPONENT to STREAM,\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7fbbfafe00b19036c820dfe… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7fbbfafe00b19036c820dfe… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Refactor format-f-fixed and emit-rounded-to-width into emit-fixed
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 9437ef99 by Raymond Toy at 2026-05-29T08:38:10-07:00 Refactor format-f-fixed and emit-rounded-to-width into emit-fixed Both functions rounded with `d2fixed` then wrote the result right-justified in W with the same leading-zero-drop logic and the same flet/pad-overflow handoff. Factor the shared body into `emit-fixed` with two policy flags: force-trailing-zero-p -- append a single "0" after the dot when no fractional digits naturally remain; t for the d=nil shrink path, nil for explicit-d. value-is-nonzero-p -- whether the original value was nonzero, needed because rounding can collapse a nonzero value to "0". Remove `emit-rounded-to-width` since it's basically a call to `emit-fixed`. Update lone caller appropriately. - - - - - 2 changed files: - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -497,48 +497,65 @@ nil)))))))))))) ;;; Ryu ~F +(defun emit-fixed (stream rounded is-negative-p w + overflowchar padchar at-sign-p + force-trailing-zero-p value-is-nonzero-p) + "Write a d2fixed result ROUNDED right-justified in W with the usual + ~F padding and overflow rules. FORCE-TRAILING-ZERO-P appends a + single \"0\" after the dot when no fractional digits remain. + VALUE-IS-NONZERO-P enables the leading-\"0\" drop when the field + would otherwise overflow W." + (declare (type simple-string rounded)) + (let* ((len (length rounded)) + (dot (position #\. rounded)) + (int-end (or dot len)) + (frac-start (if dot (1+ dot) len)) + (frac-len (- len frac-start)) + (frac-out-len (cond ((plusp frac-len) frac-len) + (force-trailing-zero-p 1) + (t 0))) + (sign-len (if (or is-negative-p at-sign-p) 1 0)) + ;; CLHS 22.3.3.1: the leading "0" before the dot is optional + ;; when the magnitude is < 1 (integer part is exactly "0") + ;; and the original value is nonzero. Require something to be + ;; written after the dot so we never drop down to just ".". + (leading-zero-droppable + (and (= int-end 1) + (char= (char rounded 0) #\0) + value-is-nonzero-p + (plusp frac-out-len))) + (full-len (+ sign-len int-end 1 frac-out-len)) + (drop-leading-zero-p + (and leading-zero-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 rounded stream :start 0 :end int-end)) + (write-char #\. stream) + (cond ((plusp frac-len) + (write-string rounded stream :start frac-start :end len)) + (force-trailing-zero-p + (write-char #\0 stream))))) + (declare (dynamic-extent #'write-field)) + (pad-overflow stream field-len w overflowchar padchar #'write-field)))) + (defun format-f-fixed (stream value w d overflowchar padchar at-sign-p) - "Write the ~F representation of VALUE rounded to D digits after the - decimal point, right-justified in a field of width W." - (declare (type (or single-float double-float) value)) + "Write the ~F representation of VALUE rounded to exactly D digits + after the decimal point, right-justified in a field of width W. + This is the explicit-D path: no \"single zero\" rule applies, so + D=0 yields \"d.\" with nothing after the dot. The optional + leading zero before the decimal point is dropped when keeping it + would overflow W (CLHS 22.3.3.1; FORMAT.F.13)." + (declare (type (or single-float double-float) value) + (type (integer 0 *) d)) (multiple-value-bind (is-negative-p abs-value) (get-sign-and-absolute-value value) - (let* ((raw-string (d2fixed abs-value d)) - (raw-len (length raw-string)) - (sign-len (if (or is-negative-p at-sign-p) 1 0)) - (need-dot (zerop d)) - (full-field-len (+ sign-len raw-len (if need-dot 1 0))) - ;; CLHS 22.3.3.1: the leading zero before the decimal point - ;; is optional when the magnitude is nonzero and less than 1. - ;; d2fixed always emits it (e.g. "0.50" for 0.5), so detect - ;; that case here and drop the zero if the field would not - ;; otherwise fit in W. For exact zero the leading digit is - ;; required, so PLUSP ABS-VALUE gates the dropping. - (leading-zero-droppable - (and (plusp abs-value) - (>= raw-len 2) - (char= (char raw-string 0) #\0) - (char= (char raw-string 1) #\.))) - ;; Drop the leading zero if we it's droppable and W is - ;; given and the number won't fit in width W field. - (drop-leading-zero-p - (and leading-zero-droppable - w - (> full-field-len w))) - (field-len (if drop-leading-zero-p - (1- full-field-len) - full-field-len))) - (flet ((write-field () - (cond (is-negative-p (write-char #\- stream)) - (at-sign-p (write-char #\+ stream))) - (cond (drop-leading-zero-p - (write-string raw-string stream :start 1)) - (t - (write-string raw-string stream))) - (when need-dot (write-char #\. stream)))) - (declare (dynamic-extent #'write-field)) - (pad-overflow stream field-len w overflowchar padchar #'write-field))))) + (emit-fixed stream (d2fixed abs-value d) is-negative-p w + overflowchar padchar at-sign-p nil + (plusp abs-value)))) (defun reshape-fixed-length (digit-count exponent) ;; DIGIT-COUNT is the number of digits returned by d2s/f2s. That no @@ -583,62 +600,11 @@ (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) -(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 leading zero before the - decimal point is kept when the field fits in W (FORMAT.F.47) and - dropped when keeping it would overflow W (FORMAT.F.46). 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)) - (len (length rounded)) - ;; ROUNDED is "ddd" (frac=0) or "ddd.ddd" (frac>0). Locate the - ;; decimal point and the integer/fractional digit spans without - ;; allocating substrings. - (dot (position #\. rounded)) - (int-end (or dot len)) - (frac-start (if dot (1+ dot) len)) - (frac-len (- len frac-start)) - ;; At least one fractional digit is always shown; when there are - ;; none a single "0" is emitted instead. - (frac-out-len (max 1 frac-len)) - (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 the single digit "0") and nonzero, - ;; and only when the full field would not fit in W. - (leading-zero-droppable - (and (= int-end 1) - (char= (char rounded 0) #\0) - (not (zerop value)))) - (full-len (+ sign-len int-end 1 frac-out-len)) - (drop-leading-zero-p - (and leading-zero-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 rounded stream :start 0 :end int-end)) - (write-char #\. stream) - (cond ((zerop frac-len) - (write-char #\0 stream)) - (t - (write-string rounded stream :start frac-start :end len))))) - (declare (dynamic-extent #'write-field)) - (pad-overflow stream field-len w overflowchar padchar #'write-field)))) - (defun format-f-free (stream value w overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value)) (multiple-value-bind (is-negative-p abs-value) (get-sign-and-absolute-value value) - (declare (ignore abs-value)) (multiple-value-bind (mantissa exponent) (parsed-exp-form (float-to-string value)) (let* ((digit-count (mantissa-digit-count mantissa)) @@ -658,16 +624,15 @@ (loop repeat w do (write-char overflowchar stream))) (t - ;; The shortest form does not fit in W. D was not specified, - ;; so round the value to the largest number of fractional - ;; digits D-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. EMIT-ROUNDED-TO- - ;; WIDTH may drop the leading "0" before the dot if keeping it - ;; would still overflow W. - (emit-rounded-to-width stream value (max 0 d-fit) - is-negative-p w - overflowchar padchar at-sign-p))))))) + ;; The shortest form does not fit in W. Round to the largest + ;; number of fractional digits D-FIT that fits and emit via + ;; EMIT-FIXED, forcing a trailing "0" if the fraction rounds + ;; away (CLHS 22.3.3.1; FORMAT.F.46 may drop the leading "0" + ;; before the dot if keeping it would still overflow W). + (emit-fixed stream + (d2fixed abs-value (max 0 d-fit)) + is-negative-p w overflowchar padchar at-sign-p + t (plusp abs-value)))))))) (defun format-f (stream value w d k overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7432,15 +7432,31 @@ msgid "Buffer size for d2fixed." msgstr "" #: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" +msgid "" +"Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered).\n" +" D is the number to convert and PRECISION is the number of digits\n" +" after the decimal point. The total number of digits could be more." msgstr "" #: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." +msgid "" +"Lisp interface to Ryu d2exp (specifically d2exp-buffered). D is the\n" +" number to convert and PRECISION is the number of digits after the\n" +" decimal point. The result is of the form \"d.ddddEeee\"." msgstr "" #: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2s (specifically d2s_buffered" +msgid "" +"Lisp interface to Ryu d2s (specifically d2s_buffered. D is the number\n" +" to convert and the result is the shortest string that reproduces the\n" +" value when read back in." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Lisp interface to Ryu f2s (specifically f2s_buffered. D is the number\n" +" to convert and the result is the shortest string that reproduces the\n" +" value when read back in." msgstr "" #: src/code/ryu-print.lisp @@ -7449,6 +7465,15 @@ msgid "" " form." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Parse RAW-STRING which is a number in exponential form and return the\n" +" mantissa part as a string and the exponent part as an integer.\n" +"\n" +" RAW-STRING is of the form \"d.ddddEeee\" where the exponent marker\n" +" must exist and must be \"e\" or \"E\"." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Return the number of significant digits in MANTISSA, a string of\n" @@ -7462,6 +7487,24 @@ msgid "" " double-float's exponent, so 0 <= n <= 324." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Find the largest d (precision) value that fits in width W given the\n" +" actual exponent (adjusted by k), and whether signs are printed or\n" +" not.\n" +"\n" +" Returns NIL if no width d can fit in a field of length w." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Compute length of the ~E result with the given parameters, but don't\n" +" build the string. MANTISSA is \"d[.dddd]\" from d2exp or\n" +" d2s. ACTUAL-EXP is the exponent with scaling factor applied. If\n" +" DROP-LEADING-ZERO-P is non-NIL, the leading \"0\" before the dot (in\n" +" the K <= 0 form) is omitted from the length." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Write MANTISSA-TEXT to STREAM, shifting the decimal point so that\n" @@ -7484,6 +7527,24 @@ msgid "" " the double-float absolute value of VALUE." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"Compute precision for d2exp when CL requests D digits and the\n" +" scale factor is K." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Write the ~E representation of MANTISSA * 10^EXPONENT to STREAM,\n" +" right-justified in a field of width W. If specified, the PADCHAR is\n" +" inserted. If OVERFLOWCHAR is given and the result won't fit in the\n" +" field, OVERFLOWCHAR replaces the result.\n" +"\n" +" K is the scale factor causing the decimal point to be placed K\n" +" digits in from the start and the displayed exponent is adjusted\n" +" appropriately." +msgstr "" + #: src/code/ryu-print.lisp msgid "" "Emit \"[sign][INT-DIGITS].[marker][exp-sign][exp]\" with no\n" @@ -7495,15 +7556,21 @@ 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 leading zero before the\n" -" decimal point is kept when the field fits in W (FORMAT.F.47) and\n" -" dropped when keeping it would overflow W (FORMAT.F.46). Used by\n" -" the free-format ~F path when the shortest representation does not\n" -" fit in W." +"Write a d2fixed result ROUNDED right-justified in W with the usual\n" +" ~F padding and overflow rules. FORCE-TRAILING-ZERO-P appends a\n" +" single \"0\" after the dot when no fractional digits remain.\n" +" VALUE-IS-NONZERO-P enables the leading-\"0\" drop when the field\n" +" would otherwise overflow W." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Write the ~F representation of VALUE rounded to exactly D digits\n" +" after the decimal point, right-justified in a field of width W.\n" +" This is the explicit-D path: no \"single zero\" rule applies, so\n" +" D=0 yields \"d.\" with nothing after the dot. The optional\n" +" leading zero before the decimal point is dropped when keeping it\n" +" would overflow W (CLHS 22.3.3.1; FORMAT.F.13)." msgstr "" #: src/code/print.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9437ef99de47af8616e2bfd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9437ef99de47af8616e2bfd… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Add some docstrings and comments
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 7dfbfb1b by Raymond Toy at 2026-05-29T08:10:18-07:00 Add some docstrings and comments No functional changes. - - - - - 1 changed file: - src/code/ryu-print.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -38,7 +38,9 @@ "Buffer size for d2fixed.") (defun d2fixed (d precision) - "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" + "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered). + D is the number to convert and PRECISION is the number of digits + after the decimal point. The total number of digits could be more." (declare (double-float d) (type (integer 0 #.+d2fixed-max-precision+) precision)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) @@ -54,7 +56,9 @@ (alien:cast buf c-call:c-string))) (defun d2exp (d precision) - "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." + "Lisp interface to Ryu d2exp (specifically d2exp-buffered). D is the + number to convert and PRECISION is the number of digits after the + decimal point. The result is of the form \"d.ddddEeee\"." (declare (double-float d) (type (integer 0 #.+d2fixed-max-precision+) precision)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) @@ -70,7 +74,9 @@ (alien:cast buf c-call:c-string))) (defun d2s (d) - "Lisp interface to Ryu d2s (specifically d2s_buffered" + "Lisp interface to Ryu d2s (specifically d2s_buffered. D is the number + to convert and the result is the shortest string that reproduces the + value when read back in." (declare (double-float d)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) (alien:alien-funcall @@ -83,6 +89,9 @@ (alien:cast buf c-call:c-string))) (defun f2s (s) + "Lisp interface to Ryu f2s (specifically f2s_buffered. D is the number + to convert and the result is the shortest string that reproduces the + value when read back in." (declare (single-float s)) (alien:with-alien ((buf (alien:array c-call:char 16))) (alien:alien-funcall @@ -103,17 +112,14 @@ (double-float (d2s (abs f))) (single-float (f2s (abs f))))) -(defun parsed-d2exp (pos-x digits) - (let* ((raw (d2exp pos-x digits)) - ;; Parse the result from d2exp. It has the form "d.dddEeee". - (e-pos (position #\e raw)) - (mantissa (subseq raw 0 e-pos)) - (exp (parse-integer raw :start (1+ e-pos)))) - (values mantissa exp))) - (defun parsed-exp-form (raw-string) + "Parse RAW-STRING which is a number in exponential form and return the + mantissa part as a string and the exponent part as an integer. + + RAW-STRING is of the form \"d.ddddEeee\" where the exponent marker + must exist and must be \"e\" or \"E\"." ;; Parse RAW-STRING, that is in exponential form. That is, it must - ;; the form "d.dddEeee". There cannot be a leading sign. + ;; the form "d.dddEeee". There cannot be a leading sign. Returns (let* ((e-pos (position-if #'(lambda (c) (member c '(#\e #\E))) raw-string)) @@ -133,12 +139,20 @@ (- (length mantissa) (if (find #\. mantissa) 1 0))) +(defun count-decimal-digits (n) + "Number of decimal digits in N. N is the absolute value of a + double-float's exponent, so 0 <= n <= 324." + (declare (type (integer 0 324) n)) + (cond ((< n 10) 1) + ((< n 100) 2) + (t 3))) + (defun compute-d-for-width (w e k actual-exp is-negative-p at-sign-p) - ;; Find the largest d (precision) value that fits in width W given - ;; the actual exponent (adjusted by k), and whether signs are - ;; printed or not. - ;; - ;; Returns NIL if no width d can fit in a field of length w. + "Find the largest d (precision) value that fits in width W given the + actual exponent (adjusted by k), and whether signs are printed or + not. + + Returns NIL if no width d can fit in a field of length w." (declare (fixnum k actual-exp)) (let* ((sign-len (if (or is-negative-p at-sign-p) 1 0)) (exp-digits (max (or e 1) @@ -162,25 +176,16 @@ (t d-fit)))) -(defun count-decimal-digits (n) - "Number of decimal digits in N. N is the absolute value of a - double-float's exponent, so 0 <= n <= 324." - (declare (type (integer 0 324) n) - (optimize speed)) - (cond ((< n 10) 1) - ((< n 100) 2) - (t 3))) - (defun compute-exp-output-length (mantissa actual-exp k e is-negative-p at-sign-p drop-leading-zero-p) + "Compute length of the ~E result with the given parameters, but don't + build the string. MANTISSA is \"d[.dddd]\" from d2exp or + d2s. ACTUAL-EXP is the exponent with scaling factor applied. If + DROP-LEADING-ZERO-P is non-NIL, the leading \"0\" before the dot (in + the K <= 0 form) is omitted from the length." (declare (type simple-string mantissa) (fixnum actual-exp k) (type (or null fixnum) e)) - ;; Compute length of the ~E result with the given parameters, but - ;; don't build the string. MANTISSA is "d[.dddd]" from d2exp or d2s. - ;; ACTUAL-EXP is the exponent with scaling factor applied. If - ;; DROP-LEADING-ZERO-P is non-NIL, the leading "0" before the dot - ;; (in the K <= 0 form) is omitted from the length. (let* ((sign-len (if (or is-negative-p at-sign-p) 1 0)) (exp-digits (max (or e 1) (count-decimal-digits (abs actual-exp)))) @@ -309,8 +314,8 @@ (abs (float value 1d0)))))) (defun d2exp-precision (d k) - ;; Compute precision for d2exp when CL requests D digits and the - ;; scale factor is K." + "Compute precision for d2exp when CL requests D digits and the + scale factor is K." (cond ((plusp k) ;; k digits before the decimal, d-k+1 after, so D is the ;; right precision for d2exp. @@ -326,6 +331,14 @@ (defun format-e-string (stream mantissa exponent is-negative-p w e k overflowchar padchar exponentchar at-sign-p drop-leading-zero-p) + "Write the ~E representation of MANTISSA * 10^EXPONENT to STREAM, + right-justified in a field of width W. If specified, the PADCHAR is + inserted. If OVERFLOWCHAR is given and the result won't fit in the + field, OVERFLOWCHAR replaces the result. + + K is the scale factor causing the decimal point to be placed K + digits in from the start and the displayed exponent is adjusted + appropriately." (declare (type simple-string mantissa) (fixnum exponent k)) (let* ((shown-exp (- exponent (1- k))) @@ -486,6 +499,8 @@ ;;; Ryu ~F (defun format-f-fixed (stream value w d overflowchar padchar at-sign-p) + "Write the ~F representation of VALUE rounded to D digits after the + decimal point, right-justified in a field of width W." (declare (type (or single-float double-float) value)) (multiple-value-bind (is-negative-p abs-value) (get-sign-and-absolute-value value) @@ -500,13 +515,15 @@ ;; that case here and drop the zero if the field would not ;; otherwise fit in W. For exact zero the leading digit is ;; required, so PLUSP ABS-VALUE gates the dropping. - (lpoint-droppable + (leading-zero-droppable (and (plusp abs-value) (>= raw-len 2) (char= (char raw-string 0) #\0) (char= (char raw-string 1) #\.))) + ;; Drop the leading zero if we it's droppable and W is + ;; given and the number won't fit in width W field. (drop-leading-zero-p - (and lpoint-droppable + (and leading-zero-droppable w (> full-field-len w))) (field-len (if drop-leading-zero-p @@ -595,13 +612,13 @@ ;; The leading "0." may be shortened to "." when the magnitude ;; is < 1 (integer part is the single digit "0") and nonzero, ;; and only when the full field would not fit in W. - (lpoint-droppable + (leading-zero-droppable (and (= int-end 1) (char= (char rounded 0) #\0) (not (zerop value)))) (full-len (+ sign-len int-end 1 frac-out-len)) (drop-leading-zero-p - (and lpoint-droppable w (> full-len w))) + (and leading-zero-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)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7dfbfb1bd126c1acf148867… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7dfbfb1bd126c1acf148867… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Drop fractional digit in ~E d-specified when k consumes it
by Raymond Toy (＠rtoy) 29 May '26

29 May '26

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/21d82127a595a016ea6e4f2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/21d82127a595a016ea6e4f2… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Drop fractional digit in ~E d=nil when width too tight
by Raymond Toy (＠rtoy) 28 May '26

28 May '26

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/c841c128d7b018e4ff0b49f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c841c128d7b018e4ff0b49f… 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

1 0

[Git][cmucl/cmucl][rtoy-print-using-ryu] Fix ~F d=nil to drop leading zero only when needed
by Raymond Toy (＠rtoy) 28 May '26

28 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 7e00ca38 by Raymond Toy at 2026-05-28T12:48:53-07:00 Fix ~F d=nil to drop leading zero only when needed Two ansi-tests show opposite behavior for the leading "0." ~F when a width is given but no d (precision) is specified. FORMAT.F.46 wants ".0" for "~2f 0.01" (drop) because the width is just 2. FORMAT.F.47 wants "0.0" for "~3f 1e-6" (keep). The rule: keep the zero when the result fits in a width, W; drop it only when keeping would overflow. Added tests for this and updated cmucl.pot - - - - - 3 changed files: - src/code/ryu-print.lisp - src/i18n/locale/cmucl.pot - tests/ryu.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -489,10 +489,11 @@ 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." + decimal point (CLHS 22.3.3.1). The leading zero before the + decimal point is kept when the field fits in W (FORMAT.F.47) and + dropped when keeping it would overflow W (FORMAT.F.46). 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)) @@ -510,7 +511,7 @@ (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 the single digit "0") and nonzero, - ;; and the full field would not fit in W. + ;; and only when the full field would not fit in W. (lpoint-droppable (and (= int-end 1) (char= (char rounded 0) #\0) @@ -544,23 +545,14 @@ (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))) - ;; 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]" + (d-fit (and w (- w sign-len int-len 1)))) (cond ((or (null w) (>= d-fit shortest-d)) ;; 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)) - ((and overflowchar (minusp frac-fit)) + ((and overflowchar (minusp d-fit)) ;; Not even the integer part and decimal point fit, and an ;; overflow character was supplied: fill the field. (loop repeat w @@ -568,12 +560,12 @@ (t ;; 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) + ;; digits D-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. EMIT-ROUNDED-TO- + ;; WIDTH may drop the leading "0" before the dot if keeping it + ;; would still overflow W. + (emit-rounded-to-width stream value (max 0 d-fit) is-negative-p w overflowchar padchar at-sign-p))))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7490,10 +7490,11 @@ msgid "" " 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." +" decimal point (CLHS 22.3.3.1). The leading zero before the\n" +" decimal point is kept when the field fits in W (FORMAT.F.47) and\n" +" dropped when keeping it would overflow W (FORMAT.F.46). Used by\n" +" the free-format ~F path when the shortest representation does not\n" +" fit in W." msgstr "" #: src/code/print.lisp ===================================== tests/ryu.lisp ===================================== @@ -767,18 +767,24 @@ (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. + ;; ANSI FORMAT.F.45/F.46/F.47: ~F with unspecified d rounds the + ;; value to the fractional digits that fit in W, always shows at + ;; least one fractional digit (a single "0" if the fraction rounds + ;; away), and drops the leading "0." -> "." only when keeping it + ;; would overflow W. + ;; ~2f of 1.1 and 1.9 round to integers, forced ".0", overflow to 3 + ;; (FORMAT.F.45). (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))) + ;; ~3f of 1e-6: "0.0" fits w=3 exactly, leading zero kept + ;; (FORMAT.F.47). + (assert-equal "0.0" (lisp::format-f 1.0f-6 3 nil 0 nil nil nil)) + ;; ~4f of 1e-6: "0.00" fits w=4 exactly. + (assert-equal "0.00" (lisp::format-f 1.0f-6 4 nil 0 nil nil nil)) + ;; ~2f, ~1f, ~0f of 0.01: leading zero dropped to ".0" (FORMAT.F.46). + (assert-equal ".0" (lisp::format-f 0.01f0 2 nil 0 nil nil nil)) + (assert-equal ".0" (lisp::format-f 0.01f0 1 nil 0 nil nil nil)) + (assert-equal ".0" (lisp::format-f 0.01f0 0 nil 0 nil nil nil))) (define-test format-f.single-narrow-width-with-overflow-char (:tag :format-f :single-float) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7e00ca38b5112e3ccd5e824… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7e00ca38b5112e3ccd5e824… 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

1 0