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

[Git][cmucl/cmucl] Pushed new branch issue-504-read-denormals-with-rounding
by Raymond Toy (＠rtoy) 26 May '26

26 May '26

Raymond Toy pushed new branch issue-504-read-denormals-with-rounding at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-504-read-denormals-… 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] Remove duplicate *use-ryu-printer*
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: b71a67e2 by Raymond Toy at 2026-05-25T09:29:39-07:00 Remove duplicate *use-ryu-printer* Default to T. - - - - - 1 changed file: - src/code/ryu-print.lisp Changes: ===================================== src/code/ryu-print.lisp ===================================== @@ -23,15 +23,6 @@ printing of DOUBLE-DOUBLE-FLOAT values) always fall back to the Burger and Dybvig code regardless of this variable.") -(defvar *use-ryu-printer* nil - "When non-NIL, format directives ~E, ~F, ~G and the float printer used - by PRINC/PRIN1/PRINT/WRITE route through the Ryu-based formatter - (FORMAT-E, FORMAT-F, FORMAT-G, and the shortest-form D2S/F2S - routines). When NIL, the original Burger and Dybvig based code is - used. Some cases (notably ~F with non-zero scale factor K, and - printing of DOUBLE-DOUBLE-FLOAT values) always fall back to the - Burger and Dybvig code regardless of this variable.") - ;;; Ryu interface ;; This could be larger, but that would mean larger stack size for the View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b71a67e281f3eab0f6e950b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b71a67e281f3eab0f6e950b… 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 tests after fixing ansi-test format.f.5 fix
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: e469d3aa by Raymond Toy at 2026-05-25T07:47:04-07:00 Fix tests after fixing ansi-test format.f.5 fix When d is unspecified and the shortest form doesn't fit in w, we need to print all digits so that round-tripping works by expanding the field instead of truncating. - - - - - 1 changed file: - tests/ryu.lisp Changes: ===================================== tests/ryu.lisp ===================================== @@ -367,18 +367,21 @@ (assert-equal " 1.0" (lisp::format-f 1d0 10 nil 0 nil nil nil))) -(define-test format-f.d-nil-with-w-shrinks +(define-test format-f.d-nil-with-w-no-shrink (:tag :format-f) - ;; d=nil with tight width: must shrink fractional digits via d2fixed. - ;; 3.141592653589793 has 16 fractional digits at shortest; w=8 only - ;; allows 6 (sign 0 + int 1 + dot 1 + frac 6 = 8). - (assert-equal "3.141593" - (lisp::format-f 3.141592653589793d0 8 nil 0 nil nil nil)) - (assert-equal "3.14159265" + ;; 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" + (lisp::format-f 1.234567d0 6 nil 0 nil nil nil)) + (assert-equal "3.141592653589793" (lisp::format-f 3.141592653589793d0 10 nil 0 nil nil nil)) - ;; The shrink should round correctly: 5 with following digits rounds up. - (assert-equal "1.2346" - (lisp::format-f 1.234567d0 6 nil 0 nil nil nil))) + (assert-equal "3.141592653589793" + (lisp::format-f 3.141592653589793d0 8 nil 0 nil nil nil))) (define-test format-f.d-nil-with-w-overflow (:tag :format-f) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e469d3aa23e307b29cf29ae… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e469d3aa23e307b29cf29ae… 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] Use the correct exponent marker for ~E and ~G
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 5bd680bc by Raymond Toy at 2026-05-25T07:42:55-07:00 Use the correct exponent marker for ~E and ~G We were always using d for the ryu printer, but the marker depends on the type of the number and `*read-default-float-format*`. - - - - - 1 changed file: - src/code/format.lisp Changes: ===================================== src/code/format.lisp ===================================== @@ -1893,7 +1893,14 @@ (float-nan-p number))) (prin1 number stream)) (t - (write-string (lisp::format-e 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. + (write-string (lisp::format-e number w d e k ovf pad + (or marker (format-exponent-marker number)) + atsign) stream))) (values)) @@ -1971,7 +1978,9 @@ (prin1 number stream) nil) (t - (write-string (lisp::format-g number w d e (or k 1) ovf pad marker atsign) + (write-string (lisp::format-g number w d e (or k 1) ovf pad + (or marker (format-exponent-marker number)) + atsign) stream))) (values)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5bd680bcf4cee4c2fe91e5a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5bd680bcf4cee4c2fe91e5a… 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] 2 commits: Handle k=nil in format-fixed-ryu
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: fbb33ee9 by Raymond Toy at 2026-05-25T07:00:06-07:00 Handle k=nil in format-fixed-ryu It was done in format-fixed-aux, but it makes more sense to do this in format-fixed-ryu. If k=nil, set k = 0. - - - - - cf9d41e9 by Raymond Toy at 2026-05-25T07:10:10-07:00 Fix ansi-test format.f.13 failure The output should be ".50" instead of "0.50" that we were producing. Tests updated. The update includes things that we haven't fixed yet, so skip CI. [skip-ci] - - - - - 3 changed files: - src/code/format.lisp - src/code/ryu-print.lisp - tests/ryu.lisp Changes: ===================================== src/code/format.lisp ===================================== @@ -1585,7 +1585,7 @@ ((and lisp::*use-ryu-printer* (or (null k) (zerop k)) (typep number '(or single-float double-float))) - (format-fixed-ryu stream number w d (or k 0) ovf pad atsign)) + (format-fixed-ryu stream number w d k ovf pad atsign)) (t (format-fixed-aux-bd stream number w d k ovf pad atsign)))) @@ -1599,7 +1599,7 @@ (prin1 number stream) nil) (t - (write-string (lisp::format-f number w d k ovf pad atsign) stream))) + (write-string (lisp::format-f number w d (or k 0) ovf pad atsign) stream))) nil) (defun format-fixed-aux-bd (stream number w d k ovf pad atsign) ===================================== src/code/ryu-print.lisp ===================================== @@ -412,11 +412,32 @@ (raw-len (length raw-string)) (sign-len (if (or is-negative-p at-sign-p) 1 0)) (need-dot (zerop d)) - (field-len (+ sign-len raw-len (if need-dot 1 0)))) + (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. + (lpoint-droppable + (and (plusp abs-value) + (>= raw-len 2) + (char= (char raw-string 0) #\0) + (char= (char raw-string 1) #\.))) + (drop-leading-zero-p + (and lpoint-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))) - (write-string raw-string 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))))) @@ -482,17 +503,21 @@ (d-fit (and w (- w sign-len int-len 1)))) (cond ((or (null w) (>= d-fit shortest-d)) + ;; No width or the shortest form fits within a field width + ;; of W. (emit-shortest stream mantissa exponent is-negative-p w overflowchar padchar at-sign-p)) - ((minusp d-fit) - (cond (overflowchar - (loop repeat w do (write-char overflowchar stream))) - (t - (emit-shortest stream mantissa exponent is-negative-p w - overflowchar padchar at-sign-p)))) - (t - (format-f-fixed stream value w d-fit - overflowchar padchar at-sign-p))))))) + (overflowchar + ;; Shortest form does not fit and OVERFLOWCHAR is set; fill + ;; the field with overflow characters. + (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))))))) (defun format-f (value w d k overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value) ===================================== tests/ryu.lisp ===================================== @@ -732,6 +732,68 @@ (assert-equal " 3.14" (lisp::format-f 3.14f0 10 nil 0 nil nil nil))) +(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. + (assert-equal "1.0" + (lisp::format-f 1.0f0 2 nil 0 nil nil nil)) + (assert-equal "1.0" + (lisp::format-f 1.0f0 1 nil 0 nil nil nil)) + ;; Same for double-floats. + (assert-equal "1.0" + (lisp::format-f 1.0d0 2 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 + ;; character when the shortest form does not fit. + (assert-equal "**" + (lisp::format-f 1.0f0 2 nil 0 #\* nil nil)) + (assert-equal "***" + (lisp::format-f 1234.5f0 3 nil 0 #\* nil nil))) + +(define-test format-f.optional-leading-zero + (:tag :format-f :single-float :double-float) + ;; CLHS 22.3.3.1: "a zero is printed before the decimal point if + ;; there is room". When the field is too narrow to fit the leading + ;; zero, it is dropped, and the output starts with the decimal point. + ;; ANSI tests FORMAT.F.13-16. + ;; + ;; ~3,2F of 0.5 -> ".50" + (assert-equal ".50" (lisp::format-f 0.5f0 3 2 0 nil nil nil)) + (assert-equal ".50" (lisp::format-f 0.5d0 3 2 0 nil nil nil)) + ;; ~2,1F of 0.5 -> ".5" + (assert-equal ".5" (lisp::format-f 0.5f0 2 1 0 nil nil nil)) + (assert-equal ".5" (lisp::format-f 0.5d0 2 1 0 nil nil nil)) + ;; ~4,2@F of 0.5 -> "+.50" + (assert-equal "+.50" (lisp::format-f 0.5f0 4 2 0 nil nil t)) + (assert-equal "+.50" (lisp::format-f 0.5d0 4 2 0 nil nil t)) + ;; ~2,2F of 0.5 -> ".50" (field expands beyond w=2 since no overflowchar) + (assert-equal ".50" (lisp::format-f 0.5f0 2 2 0 nil nil nil)) + (assert-equal ".50" (lisp::format-f 0.5d0 2 2 0 nil nil nil)) + ;; Negative values: ~3,2F of -0.5 -> "-.50" (field expands past w=3). + (assert-equal "-.50" (lisp::format-f -0.5d0 3 2 0 nil nil nil)) + ;; -0.5 in width 4: drops the zero, fits exactly. + (assert-equal "-.50" (lisp::format-f -0.5d0 4 2 0 nil nil nil))) + +(define-test format-f.leading-zero-kept-when-room + (:tag :format-f :single-float :double-float) + ;; When there is room for the leading zero, it must be printed. + (assert-equal " 0.50" (lisp::format-f 0.5d0 5 2 0 nil nil nil)) + (assert-equal "0.50" (lisp::format-f 0.5d0 4 2 0 nil nil nil)) + (assert-equal "0.50" (lisp::format-f 0.5d0 nil 2 0 nil nil nil))) + +(define-test format-f.leading-zero-required-for-exact-zero + (:tag :format-f :single-float :double-float) + ;; CLHS 22.3.3.1: "If the magnitude is exactly zero, a single zero + ;; digit is printed before the decimal point." Don't drop it even + ;; if the field would overflow. + (assert-equal "0.00" (lisp::format-f 0.0d0 3 2 0 nil nil nil)) + (assert-equal "0.00" (lisp::format-f 0.0f0 3 2 0 nil nil nil))) + (define-test format-f.single-negative-zero (:tag :format-f :single-float) (assert-equal "-0.0" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/688dc657b478b490021177… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/688dc657b478b490021177… 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] Integrate Ryu printer into ~F and ~G.
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl Commits: 688dc657 by Raymond Toy at 2026-05-25T06:22:05-07:00 Integrate Ryu printer into ~F and ~G. Same idea as for ~E. Dispatch to Ryu if the number is a single or double-float and if *use-ryu-printer* is T. Fixed an issue with ~F and ~G where the default value for k is NIL. This is different for ~E where the default is k=1. Updated output-float-aux (print and friends) to use Ryu too. Let's compile ryu-print before print. Tests added for format using ryu. - - - - - 6 changed files: - src/code/format.lisp - src/code/print.lisp - src/i18n/locale/cmucl.pot - src/tools/worldbuild.lisp - src/tools/worldcom.lisp - tests/ryu.lisp Changes: ===================================== src/code/format.lisp ===================================== @@ -1583,9 +1583,9 @@ ;; DOUBLE-DOUBLE-FLOAT) always falls through to the B&D path. (cond ((and lisp::*use-ryu-printer* - (and k (zerop k)) + (or (null k) (zerop k)) (typep number '(or single-float double-float))) - (format-fixed-ryu stream number w d k ovf pad atsign)) + (format-fixed-ryu stream number w d (or k 0) ovf pad atsign)) (t (format-fixed-aux-bd stream number w d k ovf pad atsign)))) @@ -1971,7 +1971,7 @@ (prin1 number stream) nil) (t - (write-string (lisp::format-g number w d e k ovf pad marker atsign) + (write-string (lisp::format-g number w d e (or k 1) ovf pad marker atsign) stream))) (values)) ===================================== src/code/print.lisp ===================================== @@ -2001,6 +2001,67 @@ radix-R. If you have a power-list then pass it in as PL." (defun output-float-aux (x stream e-min e-max) + ;; 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 *use-ryu-printer* + (typep x '(or single-float double-float))) + (output-float-ryu x stream e-min e-max)) + (t + (output-float-aux-bd x stream e-min e-max)))) + +(defun output-float-ryu (x stream e-min e-max) + "Ryu-based implementation of free-format float printing. Uses + FLOAT-TO-STRING (D2S/F2S) to obtain the shortest round-tripping digit + string, then dispatches on the exponent to either free or exponential + notation, matching the layout produced by OUTPUT-FLOAT-AUX-BD." + (multiple-value-bind (mantissa actual-exp) + (parsed-exp-form (float-to-string x)) + ;; MANTISSA is "d.ddd"; strip the decimal point so STRING is just + ;; the digit run, matching the second value of FLONUM-TO-DIGITS. + ;; The B&D convention is that the value equals 0.STRING * 10^E, + ;; so E = ACTUAL-EXP + 1 (mantissa "d.ddd" has the point one + ;; position right of the implicit "0."). + (let* ((dot-pos (position #\. mantissa)) + (string (if dot-pos + (concatenate 'string + (subseq mantissa 0 dot-pos) + (subseq mantissa (1+ dot-pos))) + mantissa)) + (e (1+ actual-exp))) + (cond + ((< e-min e e-max) + ;; free format + (cond ((plusp e) + (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 (<= (length string) e) + (write-char #\0 stream)) + (print-float-exponent x 0 stream)) + (t + (write-string "0." stream) + (dotimes (i (- e)) + (write-char #\0 stream)) + (write-string string stream) + (print-float-exponent x 0 stream)))) + (t + ;; Exponential format + (write-string string stream :end 1) + (write-char #\. stream) + (write-string string stream :start 1) + ;; CLHS 22.1.3.1.3 says at least one digit must be printed + ;; after the decimal point. + (when (= (length string) 1) + (write-char #\0 stream)) + (print-float-exponent x (1- e) stream)))))) + +(defun output-float-aux-bd (x stream e-min e-max) + "Burger and Dybvig based implementation of free-format float printing." (multiple-value-bind (e string) (flonum-to-digits x) (cond ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7412,6 +7412,71 @@ msgstr "" msgid "Trying to output binary data to a text stream." msgstr "" +#: src/code/ryu-print.lisp +msgid "" +"When non-NIL, format directives ~E, ~F, ~G and the float printer used\n" +" by PRINC/PRIN1/PRINT/WRITE route through the Ryu-based formatter\n" +" (FORMAT-E, FORMAT-F, FORMAT-G, and the shortest-form D2S/F2S\n" +" routines). When NIL, the original Burger and Dybvig based code is\n" +" used. Some cases (notably ~F with non-zero scale factor K, and\n" +" printing of DOUBLE-DOUBLE-FLOAT values) always fall back to the\n" +" Burger and Dybvig code regardless of this variable." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "Maximum precision (fractional digits for d2fixed." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "Buffer size for d2fixed." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" +msgstr "" + +#: src/code/ryu-print.lisp +msgid "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "Lisp interface to Ryu d2s (specifically d2s_buffered" +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Convert F, a single-float or double-float, to a string of the shortest\n" +" form." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Number of decimal digits in N. N is the absolute value of a\n" +" double-float's exponent, so 0 <= n <= 324." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Write MANTISSA-TEXT to STREAM, shifting the decimal point so that\n" +" the new dot lands K digits in from the start of the digit string.\n" +" MANTISSA-TEXT is 'D' or 'D.DDDD' from d2s/d2exp.\n" +" DROP-LEADING-ZERO-P controls whether the leading '0' before the dot\n" +" is emitted when the result starts with '0.'. K=0 puts the dot\n" +" before all digits; K=1 leaves it at the original position." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero\n" +" arguments that writes the field characters to STREAM." +msgstr "" + +#: src/code/ryu-print.lisp +msgid "" +"Returns two values for the float VALUE: T if the value is negative and\n" +" the double-float absolute value of VALUE." +msgstr "" + #: src/code/print.lisp msgid "" "If true, all objects will printed readably. If readably printing is\n" @@ -7711,6 +7776,18 @@ msgstr "" msgid "Print out a double-double to a string" msgstr "" +#: src/code/print.lisp +msgid "" +"Ryu-based implementation of free-format float printing. Uses\n" +" FLOAT-TO-STRING (D2S/F2S) to obtain the shortest round-tripping digit\n" +" string, then dispatches on the exponent to either free or exponential\n" +" notation, matching the layout produced by OUTPUT-FLOAT-AUX-BD." +msgstr "" + +#: src/code/print.lisp +msgid "Burger and Dybvig based implementation of free-format float printing." +msgstr "" + #: src/code/print.lisp msgid "Weak Pointer: " msgstr "" @@ -7787,71 +7864,6 @@ msgstr "" msgid "Cannot find ~S, so unicode support is not available" msgstr "" -#: src/code/ryu-print.lisp -msgid "" -"When non-NIL, format directives ~E, ~F, ~G and the float printer used\n" -" by PRINC/PRIN1/PRINT/WRITE route through the Ryu-based formatter\n" -" (FORMAT-E, FORMAT-F, FORMAT-G, and the shortest-form D2S/F2S\n" -" routines). When NIL, the original Burger and Dybvig based code is\n" -" used. Some cases (notably ~F with non-zero scale factor K, and\n" -" printing of DOUBLE-DOUBLE-FLOAT values) always fall back to the\n" -" Burger and Dybvig code regardless of this variable." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "Maximum precision (fractional digits for d2fixed." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "Buffer size for d2fixed." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" -msgstr "" - -#: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "Lisp interface to Ryu d2s (specifically d2s_buffered" -msgstr "" - -#: src/code/ryu-print.lisp -msgid "" -"Convert F, a single-float or double-float, to a string of the shortest\n" -" form." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "" -"Number of decimal digits in N. N is the absolute value of a\n" -" double-float's exponent, so 0 <= n <= 324." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "" -"Write MANTISSA-TEXT to STREAM, shifting the decimal point so that\n" -" the new dot lands K digits in from the start of the digit string.\n" -" MANTISSA-TEXT is 'D' or 'D.DDDD' from d2s/d2exp.\n" -" DROP-LEADING-ZERO-P controls whether the leading '0' before the dot\n" -" is emitted when the result starts with '0.'. K=0 puts the dot\n" -" before all digits; K=1 leaves it at the original position." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "" -"Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero\n" -" arguments that writes the field characters to STREAM." -msgstr "" - -#: src/code/ryu-print.lisp -msgid "" -"Returns two values for the float VALUE: T if the value is negative and\n" -" the double-float absolute value of VALUE." -msgstr "" - #: src/code/pprint.lisp msgid "" "Insert an annotation into the pretty-printing stream STREAM.\n" ===================================== src/tools/worldbuild.lisp ===================================== @@ -156,8 +156,8 @@ "target:code/serve-event" "target:code/stream" "target:code/fd-stream" - "target:code/print" "target:code/ryu-print" + "target:code/print" "target:code/pprint" "target:code/format" "target:code/package" ===================================== src/tools/worldcom.lisp ===================================== @@ -237,8 +237,8 @@ (comf "target:code/save") (comf "target:code/stream") -(comf "target:code/print") (comf "target:code/ryu-print") +(comf "target:code/print") (comf "target:code/pprint") #-no-runtime (comf "target:code/pprint" :byte-compile t) (comf "target:code/pprint-loop") ===================================== tests/ryu.lisp ===================================== @@ -986,3 +986,75 @@ (assert-true (stringp (format nil "~G" 1/2))) (assert-true (stringp (format nil "~G" 1))))) +;;; ---------------------------------------------------------------------- +;;; Tests that the float printer used by PRIN1/PRINC/PRINT/WRITE +;;; (i.e. OUTPUT-FLOAT-AUX) dispatches through Ryu when +;;; *use-ryu-printer* is set. Both code paths should produce +;;; round-trippable strings. We don't assert character equality +;;; between the two paths because the shortest round-tripping digit +;;; sequence is allowed to differ in rounding of the tie case; we do +;;; assert each path round-trips. + +(define-test output-float.dispatch.round-trip + (:tag :output-float :dispatch) + (let ((values '(3.14d0 + -3.14d0 + 0.1d0 + 1.0d100 + 1.0d-100 + 1.0d0 + 3.14f0 + -3.14f0 + 0.1f0))) + (dolist (v values) + (let ((with-ryu + (let ((lisp::*use-ryu-printer* t)) + (prin1-to-string v))) + (without-ryu + (let ((lisp::*use-ryu-printer* nil)) + (prin1-to-string v)))) + (assert-equal v (read-from-string with-ryu) v with-ryu) + (assert-equal v (read-from-string without-ryu) v without-ryu))))) + +(define-test output-float.dispatch.princ-matches-prin1 + (:tag :output-float :dispatch) + ;; For floats, PRIN1 and PRINC produce the same string (floats don't + ;; have escape characters). This should hold under both code paths. + (let ((lisp::*use-ryu-printer* t)) + (assert-equal (prin1-to-string 3.14d0) + (princ-to-string 3.14d0)) + (assert-equal (prin1-to-string 3.14f0) + (princ-to-string 3.14f0)))) + +(define-test output-float.dispatch.zero + (:tag :output-float :dispatch) + ;; Zero is handled by OUTPUT-FLOAT itself (not OUTPUT-FLOAT-AUX), so + ;; the dispatch is never reached. Still, make sure both settings + ;; produce identical output. + (let ((with-ryu + (let ((lisp::*use-ryu-printer* t)) + (prin1-to-string 0.0d0))) + (without-ryu + (let ((lisp::*use-ryu-printer* nil)) + (prin1-to-string 0.0d0)))) + (assert-equal without-ryu with-ryu))) + +(define-test output-float.dispatch.special-values + (:tag :output-float :dispatch) + ;; Infinity and NaN are handled in OUTPUT-FLOAT itself, before the + ;; OUTPUT-FLOAT-AUX dispatch, so the Ryu path is not exercised. + ;; Verify no error. + (let ((lisp::*use-ryu-printer* t)) + (assert-true (stringp (prin1-to-string + ext:double-float-positive-infinity))))) + +(define-test output-float.dispatch.double-double + (:tag :output-float :dispatch) + ;; DOUBLE-DOUBLE-FLOAT is handled in OUTPUT-FLOAT itself when the + ;; feature is enabled (currently behind #+(and nil double-double), + ;; i.e. inactive), so it actually reaches OUTPUT-FLOAT-AUX. Confirm + ;; the type-guard in the dispatch wrapper sends it to the B&D path. + #+double-double + (let ((lisp::*use-ryu-printer* t)) + (assert-true (stringp (prin1-to-string 1w0))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/688dc657b478b490021177d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/688dc657b478b490021177d… 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 rtoy-print-using-ryu
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed new branch rtoy-print-using-ryu at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/rtoy-print-using-ryu 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-ryu-printf] Make format-f-{free,fixed} both take the value, not absolute value
by Raymond Toy (＠rtoy) 25 May '26

25 May '26

Raymond Toy pushed to branch rtoy-ryu-printf at cmucl / cmucl Commits: 03ec6ea3 by Raymond Toy at 2026-05-24T17:33:24-07:00 Make format-f-{free,fixed} both take the value, not absolute value This gets rid of the weird asymmetry where one took the value and the other took the absolute value. Also got rid of a call to remove in format-g for less consing. Updated some type declarations so better code can be generated to reduce consing even more. Current profile against B&D format. We're at least 4 times faster and up to 15 times. And 5 times and up to 12 times less consing. | Benchmark | Ryu time | B-D time | Speedup | Ryu cons | B-D cons | Cons ratio | |-----------|---------:|---------:|--------:|---------:|---------:|-----------:| | ~E d=5 | 0.290 s | 3.410 s | 11.8× | 146 MB | 898 MB | 6.2× | | ~E d=nil | 0.290 s | 2.370 s | 8.2× | 148 MB | 832 MB | 5.6× | | ~F d=5 | 0.130 s | 2.000 s | **15×** | 53 MB | 630 MB | 12× | | ~F d=nil | 0.400 s | 1.730 s | 4.3× | 100 MB | 728 MB | 7.3× | | ~G d=5 | 0.330 s | 3.840 s | **12×** | 121 MB | 928 MB | 7.7× | | ~G d=nil | 0.470 s | 5.780 s | **12×** | 123 MB | 1494 MB | 12× | 10000 iterations × 11 sample values per impl = 110000 format calls. - - - - - 2 changed files: - src/code/print.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/print.lisp ===================================== @@ -2096,7 +2096,10 @@ radix-R. If you have a power-list then pass it in as PL." raw-string)) (mantissa (subseq raw-string 0 e-pos)) (exp (parse-integer raw-string :start (1+ e-pos)))) - (values mantissa exp))) + ;; The exponent from a double-float is in the range of [-324, + ;; 308]. Just declare the exponent as a (signed-byte 11). + (values mantissa + (truly-the (signed-byte 11) 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 @@ -2138,6 +2141,9 @@ radix-R. If you have a power-list then pass it in as PL." (defun compute-exp-output-length (mantissa actual-exp k e is-negative-p at-sign-p drop-leading-zero-p) + (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 @@ -2154,19 +2160,20 @@ radix-R. If you have a power-list then pass it in as PL." ((plusp k) (cond ((> raw-digits k) - (1+ raw-digits)) ; "D.DDDD" + (1+ raw-digits)) ; "D.DDDD" ((and (= k 1) (= raw-digits 1)) - 3) ; "D.0" forced + 3) ; "D.0" forced (t - (max raw-digits k)))) ; "DDDD" + (max raw-digits k)))) ; "DDDD" (t ;; "0.000DDD" or ".000DDD" (+ (if drop-leading-zero-p 0 1) - 1 ; the dot - (- k) ; leading zeros after the dot + 1 ; the dot + (- k) ; leading zeros after the dot raw-digits))))) ;; +2 for the exponent marker and sign - (+ sign-len mantissa-len exp-digits 2))) + (the (and unsigned-byte fixnum) + (+ sign-len mantissa-len exp-digits 2)))) (defun scale-mantissa (stream mantissa-text k drop-leading-zero-p) "Write MANTISSA-TEXT to STREAM, shifting the decimal point so that @@ -2240,7 +2247,9 @@ radix-R. If you have a power-list then pass it in as PL." (defun pad-overflow (stream field-len w overflowchar padchar field-writer) "Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero arguments that writes the field characters to STREAM." - (declare (function field-writer)) + (declare (fixnum field-len) + (type (or null fixnum) w) + (function field-writer)) (cond ((null w) (funcall field-writer)) @@ -2267,7 +2276,7 @@ radix-R. If you have a power-list then pass it in as PL." (abs value))) (single-float (values (minusp (float-sign value)) - (abs (float (value 1d0))))))) + (abs (float value 1d0)))))) (defun d2exp-precision (d k) ;; Compute precision for d2exp when CL requests D digits and the @@ -2297,8 +2306,6 @@ radix-R. If you have a power-list then pass it in as PL." (exp-digits (count-decimal-digits exp-abs)) (exp-width (max (or e 1) exp-digits)) - (sign-len (if (or is-negative-p at-sign-p) - 1 0)) ;; 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 @@ -2364,23 +2371,33 @@ radix-R. If you have a power-list then pass it in as PL." nil)))))))))))) ;;; Ryu ~F -(defun format-f-fixed (stream abs-value is-negative-p w d +(defun format-f-fixed (stream value w d overflowchar padchar at-sign-p) - (declare (double-float abs-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)) - (field-len (+ sign-len raw-len (if need-dot 1 0)))) - (flet ((write-field () - (cond (is-negative-p (write-char #\- stream)) - (at-sign-p (write-char #\+ stream))) - (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)))) - + (declare (type (or single-float double-float) value)) + (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)) + (field-len (+ sign-len raw-len (if need-dot 1 0)))) + (flet ((write-field () + (cond (is-negative-p (write-char #\- stream)) + (at-sign-p (write-char #\+ stream))) + (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))))) + (defun reshape-fixed-length (digit-count exponent) + ;; DIGIT-COUNT is the number of digits returned by d2s/f2s. That no + ;; more than 20. EXPONENT is teh power of 10 for a double-float. A + ;; signed-byte 10 is large enough to hold this. + ;; + ;; We don't need to be super-precise here; we just need to be close + ;; enough so as not to use bignums. + (declare (type (integer 1 20) digit-count) + (type (signed-byte 10) exponent)) (let ((k (1+ exponent))) (cond ((zerop exponent) ;; Fast path @@ -2399,6 +2416,8 @@ radix-R. If you have a power-list then pass it in as PL." (defun emit-shortest (stream mantissa exponent is-negative-p w overflowchar padchar at-sign-p) + (declare (type simple-string mantissa) + (type (signed-byte 10) exponent)) (let* ((has-dot (find #\. mantissa)) ;; Number of digits, not including the decimal point. (digit-count (- (length mantissa) @@ -2415,53 +2434,52 @@ radix-R. If you have a power-list then pass it in as PL." (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) -(defun format-f-free (stream value is-negative-p w +(defun format-f-free (stream value w overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value)) - (multiple-value-bind (mantissa exponent) - (parsed-exp-form (float-to-string value)) - (let* ((has-dot (find #\. mantissa)) - (digit-count (if has-dot (1- (length mantissa)) (length mantissa))) - (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)))) - (cond - ((or (null w) (>= d-fit shortest-d)) - (emit-shortest stream mantissa exponent is-negative-p w - overflowchar padchar at-sign-p)) - ((minusp d-fit) - (cond (overflowchar - (loop repeat w do (write-char overflowchar stream))) - (t - (emit-shortest stream mantissa exponent is-negative-p w - overflowchar padchar at-sign-p)))) - (t - (multiple-value-bind (is-negative-p abs-value) - (get-sign-and-absolute-value value) - (format-f-fixed stream abs-value is-negative-p w d-fit + (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* ((has-dot (find #\. mantissa)) + (digit-count (if has-dot (1- (length mantissa)) (length mantissa))) + (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)))) + (cond + ((or (null w) (>= d-fit shortest-d)) + (emit-shortest stream mantissa exponent is-negative-p w + overflowchar padchar at-sign-p)) + ((minusp d-fit) + (cond (overflowchar + (loop repeat w do (write-char overflowchar stream))) + (t + (emit-shortest stream mantissa exponent is-negative-p w + overflowchar padchar at-sign-p)))) + (t + (format-f-fixed stream value w d-fit overflowchar padchar at-sign-p))))))) (defun format-f (value w d k overflowchar padchar at-sign-p) (declare (type (or single-float double-float) value) (fixnum k) (type (or null (and unsigned-byte fixnum)) w d)) - (multiple-value-bind (is-negative-p abs-value) - (get-sign-and-absolute-value value) - (with-output-to-string (s) - (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 s value w d k overflowchar padchar at-sign-p)) - (d - (format-f-fixed s abs-value is-negative-p w d overflowchar padchar at-sign-p)) - (t - ;; No d, so use d2s to get the shortest digits; convert by - ;; placing the decimal poin at the right spot. - (format-f-free s value is-negative-p w overflowchar padchar at-sign-p)))))) + (with-output-to-string (s) + (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 s value w d k overflowchar padchar at-sign-p)) + (d + (format-f-fixed s value w d overflowchar padchar at-sign-p)) + (t + ;; No d, so use d2s to get the shortest digits; convert by + ;; placing the decimal poin at the right spot. + (format-f-free s value w overflowchar padchar at-sign-p))))) ;;; Ryu ~G (defun format-g (value w d e k overflowchar padchar exponentchar at-sign-p) @@ -2470,7 +2488,9 @@ radix-R. If you have a power-list then pass it in as PL." (type (or null (and unsigned-byte fixnum)) w d e)) (multiple-value-bind (mantissa exponent) (parsed-exp-form (float-to-string value)) - (let* ((digit-count (length (remove #\. mantissa))) + (let* ((digit-count (- (length mantissa) + (if (find #\. mantissa) + 1 0))) (n (1+ exponent)) (effective-d (or d (max digit-count (min n 7)))) (ee (if e (+ e 2) 4)) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7759,6 +7759,12 @@ msgid "" " arguments that writes the field characters to STREAM." msgstr "" +#: src/code/print.lisp +msgid "" +"Returns two values for the float VALUE: T if the value is negative and\n" +" the double-float absolute value of VALUE." +msgstr "" + #: src/code/print.lisp msgid "Weak Pointer: " msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/03ec6ea3d9e183f594c5571… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/03ec6ea3d9e183f594c5571… 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-ryu-printf] Refactor some common code
by Raymond Toy (＠rtoy) 24 May '26

24 May '26

Raymond Toy pushed to branch rtoy-ryu-printf at cmucl / cmucl Commits: d3eae268 by Raymond Toy at 2026-05-24T14:39:00-07:00 Refactor some common code Add get-sign-and-absolute-value to extract the sign and absolute value of the given float. The absolute value is a double-float. Move pad-overflow before first use. - - - - - 1 changed file: - src/code/print.lisp Changes: ===================================== src/code/print.lisp ===================================== @@ -2236,6 +2236,39 @@ radix-R. If you have a power-list then pass it in as PL." ;; Finish with ".0" (write-string ".0" stream))))) +(declaim (inline pad-overflow)) +(defun pad-overflow (stream field-len w overflowchar padchar field-writer) + "Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero + arguments that writes the field characters to STREAM." + (declare (function field-writer)) + (cond + ((null w) + (funcall field-writer)) + ((and (> field-len w) + overflowchar) + (loop repeat w do + (write-char overflowchar stream))) + ((> field-len w) + (funcall field-writer)) + (t + (let ((pad (or padchar #\space))) + (loop repeat (- w field-len) + do (write-char pad stream))) + (funcall field-writer)))) + +(declaim (inline get-sign-and-absolute-value)) +(defun get-sign-and-absolute-value (value) + "Returns two values for the float VALUE: T if the value is negative and + the double-float absolute value of VALUE." + (declare (type (or single-float double-float) value)) + (etypecase value + (double-float + (values (minusp (float-sign value)) + (abs value))) + (single-float + (values (minusp (float-sign value)) + (abs (float (value 1d0))))))) + (defun d2exp-precision (d k) ;; Compute precision for d2exp when CL requests D digits and the ;; scale factor is K." @@ -2294,13 +2327,7 @@ radix-R. If you have a power-list then pass it in as PL." (type (or null (and unsigned-byte fixnum)) w d e) (optimize (speed 3))) (multiple-value-bind (is-negative-p abs-value) - (etypecase value - (double-float - (values (minusp (float-sign value)) - (abs value))) - (single-float - (values (minusp (float-sign value)) - (abs (float value 1d0))))) + (get-sign-and-absolute-value value) (with-output-to-string (stream) (cond (d @@ -2337,26 +2364,6 @@ radix-R. If you have a power-list then pass it in as PL." nil)))))))))))) ;;; Ryu ~F -(declaim (inline pad-overflow)) -(defun pad-overflow (stream field-len w overflowchar padchar field-writer) - "Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero - arguments that writes the field characters to STREAM." - (declare (function field-writer)) - (cond - ((null w) - (funcall field-writer)) - ((and (> field-len w) - overflowchar) - (loop repeat w do - (write-char overflowchar stream))) - ((> field-len w) - (funcall field-writer)) - (t - (let ((pad (or padchar #\space))) - (loop repeat (- w field-len) - do (write-char pad stream))) - (funcall field-writer)))) - (defun format-f-fixed (stream abs-value is-negative-p w d overflowchar padchar at-sign-p) (declare (double-float abs-value)) @@ -2370,7 +2377,7 @@ radix-R. If you have a power-list then pass it in as PL." (at-sign-p (write-char #\+ stream))) (write-string raw-string stream) (when need-dot (write-char #\. stream)))) - (declare (dynamic-extent #'writ-field)) + (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) (defun reshape-fixed-length (digit-count exponent) @@ -2430,9 +2437,8 @@ radix-R. If you have a power-list then pass it in as PL." (emit-shortest stream mantissa exponent is-negative-p w overflowchar padchar at-sign-p)))) (t - (let ((abs-value (etypecase value - (double-float (abs value)) - (single-float (abs value))))) + (multiple-value-bind (is-negative-p abs-value) + (get-sign-and-absolute-value value) (format-f-fixed stream abs-value is-negative-p w d-fit overflowchar padchar at-sign-p))))))) @@ -2441,13 +2447,7 @@ radix-R. If you have a power-list then pass it in as PL." (fixnum k) (type (or null (and unsigned-byte fixnum)) w d)) (multiple-value-bind (is-negative-p abs-value) - (etypecase value - (double-float - (values (minusp (float-sign value)) - (abs value))) - (single-float - (values (minusp (float-sign value)) - (abs (float value 1d0))))) + (get-sign-and-absolute-value value) (with-output-to-string (s) (cond ((not (zerop k)) ;; Complex case that doesn't fit with what d2s and d2fixed View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d3eae268580aafc60accff5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d3eae268580aafc60accff5… 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-ryu-printf] 2 commits: Change d2fixed max precison
by Raymond Toy (＠rtoy) 24 May '26

24 May '26

Raymond Toy pushed to branch rtoy-ryu-printf at cmucl / cmucl Commits: 26864253 by Raymond Toy at 2026-05-24T08:23:23-07:00 Change d2fixed max precison 1000 digits of precision for d2fixed should be enough for practical uses of d2fixed. - - - - - 683edf58 by Raymond Toy at 2026-05-24T14:13:19-07:00 First cut at float support for ~E/F/G Basically wherever we called d2s, call d2s or f2s to get the shortest string. For all the other calls to d2exp/d2fixed, we convert the float to a double. tests/ryu.lisp updated with more tests. This needs to be cleaned up. - - - - - 3 changed files: - src/code/print.lisp - src/i18n/locale/cmucl.pot - tests/ryu.lisp Changes: ===================================== src/code/print.lisp ===================================== @@ -2001,15 +2001,21 @@ radix-R. If you have a power-list then pass it in as PL." ;;; Ryu interface + +;; This could be larger, but that would mean larger stack size for the +;; foreign call. This should be large enough for practical use. (defconstant +d2fixed-max-precision+ - 64 - "") + 1000 + "Maximum precision (fractional digits for d2fixed.") (defconstant +d2fixed-buffer-size+ + ;; +320 to account for 300 ingeger digts + sign + dot + terminator + + ;; slack. (+ +d2fixed-max-precision+ 320) - "") + "Buffer size for d2fixed.") (defun d2fixed (d precision) + "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" (declare (double-float d) (type (integer 0 #.+d2fixed-max-precision+) precision)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) @@ -2025,6 +2031,7 @@ radix-R. If you have a power-list then pass it in as PL." (alien:cast buf c-call:c-string))) (defun d2exp (d precision) + "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." (declare (double-float d) (type (integer 0 #.+d2fixed-max-precision+) precision)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) @@ -2040,6 +2047,7 @@ radix-R. If you have a power-list then pass it in as PL." (alien:cast buf c-call:c-string))) (defun d2s (d) + "Lisp interface to Ryu d2s (specifically d2s_buffered" (declare (double-float d)) (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+))) (alien:alien-funcall @@ -2051,6 +2059,27 @@ radix-R. If you have a power-list then pass it in as PL." (alien:cast buf (* c-call:char))) (alien:cast buf c-call:c-string))) +(defun f2s (s) + (declare (single-float s)) + (alien:with-alien ((buf (alien:array c-call:char 16))) + (alien:alien-funcall + (alien:extern-alien "f2s_buffered" + (function c-call:void + c-call:float + (* c-call:char))) + s + (alien:cast buf (* c-call:char))) + (alien:cast buf c-call:c-string))) + +(declaim (inline float-to-string)) +(defun float-to-string (f) + "Convert F, a single-float or double-float, to a string of the shortest + form." + (declare (type (or single-float double-float) f)) + (etypecase f + (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". @@ -2260,22 +2289,29 @@ radix-R. If you have a power-list then pass it in as PL." (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 (double-float value) + (declare (type (or single-float double-float) value) (fixnum k) (type (or null (and unsigned-byte fixnum)) w d e) (optimize (speed 3))) - (let* ((is-negative-p (minusp (float-sign value))) - (abs-value (abs value))) + (multiple-value-bind (is-negative-p abs-value) + (etypecase value + (double-float + (values (minusp (float-sign value)) + (abs value))) + (single-float + (values (minusp (float-sign value)) + (abs (float value 1d0))))) (with-output-to-string (stream) (cond (d (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2exp abs-value (d2exp-precision d k))) + (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))) (t (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2s abs-value)) + (parsed-exp-form (float-to-string value)) (let* ((actual-exp (- exponent (1- k))) (full-len (compute-exp-output-length mantissa actual-exp k e is-negative-p at-sign-p @@ -2291,7 +2327,8 @@ radix-R. If you have a power-list then pass it in as PL." (drop-zero-p (and d-fit (<= k 0)))) (if d-fit (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2exp abs-value (d2exp-precision d-fit k))) + (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)) @@ -2322,6 +2359,7 @@ radix-R. If you have a power-list then pass it in as PL." (defun format-f-fixed (stream abs-value is-negative-p w d overflowchar padchar at-sign-p) + (declare (double-float abs-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)) @@ -2370,10 +2408,11 @@ radix-R. If you have a power-list then pass it in as PL." (declare (dynamic-extent #'write-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) -(defun format-f-free (stream abs-value is-negative-p w +(defun format-f-free (stream value is-negative-p w overflowchar padchar at-sign-p) + (declare (type (or single-float double-float) value)) (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2s abs-value)) + (parsed-exp-form (float-to-string value)) (let* ((has-dot (find #\. mantissa)) (digit-count (if has-dot (1- (length mantissa)) (length mantissa))) (int-len (max 1 (1+ exponent))) @@ -2391,15 +2430,24 @@ radix-R. If you have a power-list then pass it in as PL." (emit-shortest stream mantissa exponent is-negative-p w overflowchar padchar at-sign-p)))) (t - (format-f-fixed stream abs-value is-negative-p w d-fit - overflowchar padchar at-sign-p)))))) + (let ((abs-value (etypecase value + (double-float (abs value)) + (single-float (abs value))))) + (format-f-fixed stream abs-value is-negative-p w d-fit + overflowchar padchar at-sign-p))))))) (defun format-f (value w d k overflowchar padchar at-sign-p) - (declare (double-float value) + (declare (type (or single-float double-float) value) (fixnum k) (type (or null (and unsigned-byte fixnum)) w d)) - (let ((is-negative-p (minusp (float-sign value))) - (abs-value (abs value))) + (multiple-value-bind (is-negative-p abs-value) + (etypecase value + (double-float + (values (minusp (float-sign value)) + (abs value))) + (single-float + (values (minusp (float-sign value)) + (abs (float value 1d0))))) (with-output-to-string (s) (cond ((not (zerop k)) ;; Complex case that doesn't fit with what d2s and d2fixed @@ -2413,15 +2461,15 @@ radix-R. If you have a power-list then pass it in as PL." (t ;; No d, so use d2s to get the shortest digits; convert by ;; placing the decimal poin at the right spot. - (format-f-free s abs-value is-negative-p w overflowchar padchar at-sign-p)))))) + (format-f-free s value is-negative-p w overflowchar padchar at-sign-p)))))) ;;; Ryu ~G (defun format-g (value w d e k overflowchar padchar exponentchar at-sign-p) - (declare (double-float value) + (declare (type (or single-float double-float) value) (fixnum k) (type (or null (and unsigned-byte fixnum)) w d e)) (multiple-value-bind (mantissa exponent) - (parsed-exp-form (d2s (abs value))) + (parsed-exp-form (float-to-string value)) (let* ((digit-count (length (remove #\. mantissa))) (n (1+ exponent)) (effective-d (or d (max digit-count (min n 7)))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7711,8 +7711,30 @@ msgstr "" msgid "Print out a double-double to a string" msgstr "" +#: src/code/print.lisp +msgid "Maximum precision (fractional digits for d2fixed." +msgstr "" + +#: src/code/print.lisp +msgid "Buffer size for d2fixed." +msgstr "" + +#: src/code/print.lisp +msgid "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)" +msgstr "" + +#: src/code/print.lisp +msgid "Lisp interface to Ryu d2exp (specifically d2exp-buffered)." +msgstr "" + +#: src/code/print.lisp +msgid "Lisp interface to Ryu d2s (specifically d2s_buffered" +msgstr "" + #: src/code/print.lisp msgid "" +"Convert F, a single-float or double-float, to a string of the shortest\n" +" form." msgstr "" #: src/code/print.lisp ===================================== tests/ryu.lisp ===================================== @@ -602,3 +602,184 @@ ;; follow CLHS literally. (assert-equal "3.14 " (lisp::format-g 3.14d0 3 nil nil 1 #\* nil #\d nil))) + + +;;;; Single-float tests for format-e, format-f, format-g. +;;;; +;;;; The shortest-form (d-nil) paths use f2s and may produce different +;;;; digits than d2s would for the corresponding double-float value, +;;;; since the shortest round-trip representation depends on float +;;;; precision. The d-given paths widen to double and use d2fixed/ +;;;; d2exp; results match the double-float case at that precision. + +(define-test format-e.single-basic + (:tag :format-e :single-float) + ;; Default ~E exponent marker for single-floats is 'f' (matches + ;; CL's single-float-format default). + (assert-equal "3.1415927f+0" + (lisp::format-e 3.1415927f0 nil nil nil 1 nil nil #\f nil)) + (assert-equal "-3.1415927f+0" + (lisp::format-e -3.1415927f0 nil nil nil 1 nil nil #\f nil)) + (assert-equal "1.0f+0" + (lisp::format-e 1f0 nil nil nil 1 nil nil #\f nil)) + (assert-equal "1.0f-1" + (lisp::format-e 0.1f0 nil nil nil 1 nil nil #\f nil))) + +(define-test format-e.single-d-given + (:tag :format-e :single-float) + ;; d-given path: widens to double, calls d2exp. At precision 5, + ;; matches what d2exp produces for the exact double representation + ;; of the single value. + (assert-equal "3.14159f+0" + (lisp::format-e 3.1415927f0 nil 5 nil 1 nil nil #\f nil)) + (assert-equal "5.00000f-1" + (lisp::format-e 0.5f0 nil 5 nil 1 nil nil #\f nil))) + +(define-test format-e.single-shortest-differs-from-double + (:tag :format-e :single-float) + ;; The single-float path uses f2s, which gives the shortest form + ;; for the single-precision value. Widening to double first would + ;; produce a different (longer) shortest form because the widened + ;; value 0.10000000149011612d0 is not the same as 0.1d0. + (assert-equal "1.0f-1" + (lisp::format-e 0.1f0 nil nil nil 1 nil nil #\f nil)) + ;; Confirm: if you widened first, d2s on the result would give: + (assert-equal "1.0000000149011612f-1" + (lisp::format-e 0.10000000149011612d0 nil nil nil 1 nil nil #\f nil))) + + +(define-test format-e.single-boundary + (:tag :format-e :single-float) + ;; Single-float bounds. + (let ((maxs (lisp::format-e most-positive-single-float + nil nil nil 1 nil nil #\f nil))) + (assert-true (search "f+38" maxs) maxs)) + (let ((mins (lisp::format-e least-positive-single-float + nil nil nil 1 nil nil #\f nil))) + (assert-true (search "f-45" mins) mins))) + +(define-test format-e.single-negative-zero + (:tag :format-e :single-float) + (assert-equal "-0.0f+0" + (lisp::format-e (- 0f0) nil nil nil 1 nil nil #\f nil)) + (assert-equal "+0.0f+0" + (lisp::format-e 0f0 nil nil nil 1 nil nil #\f t))) + +;;; ---------------------------------------------------------------------- +;;; ~F single-float + +(define-test format-f.single-basic + (:tag :format-f :single-float) + (assert-equal "3.14" + (lisp::format-f 3.14159f0 nil 2 0 nil nil nil)) + (assert-equal "-3.14" + (lisp::format-f -3.14159f0 nil 2 0 nil nil nil)) + (assert-equal "1.00000" + (lisp::format-f 1f0 nil 5 0 nil nil nil))) + +(define-test format-f.single-d-nil + (:tag :format-f :single-float) + ;; Shortest path: f2s output for single-floats is shorter than + ;; d2s would be for the widened value. + (assert-equal "3.1415927" + (lisp::format-f 3.1415927f0 nil nil 0 nil nil nil)) + (assert-equal "1.0" + (lisp::format-f 1f0 nil nil 0 nil nil nil)) + (assert-equal "0.1" + (lisp::format-f 0.1f0 nil nil 0 nil nil nil)) + (assert-equal "0.5" + (lisp::format-f 0.5f0 nil nil 0 nil nil nil))) + +(define-test format-f.single-d-nil-vs-double + (:tag :format-f :single-float) + ;; Confirm that the single-float path uses f2s, not d2s on a + ;; widened value. For 0.1f0, f2s gives "1" at exp -1, so output + ;; is "0.1". If we widened first, d2s on the resulting double + ;; would give a longer shortest form. + (assert-equal "0.1" + (lisp::format-f 0.1f0 nil nil 0 nil nil nil)) + ;; Same numeric value, but as a double-float literal -- d2s gives + ;; the long shortest form that round-trips through double. + (assert-equal "0.10000000149011612" + (lisp::format-f 0.10000000149011612d0 nil nil 0 nil nil nil)) + ;; And 0.1d0 (the double literal nearest to 0.1) has its own + ;; shortest form, which IS "0.1" since 0.1d0 is the canonical + ;; double for that decimal. + (assert-equal "0.1" + (lisp::format-f 0.1d0 nil nil 0 nil nil nil))) + + +(define-test format-f.single-leading-zeros + (:tag :format-f :single-float) + ;; Small singles still need leading-zero handling. + (assert-equal "0.001" + (lisp::format-f 0.001f0 nil nil 0 nil nil nil)) + (assert-equal "0.00001" + (lisp::format-f 0.00001f0 nil nil 0 nil nil nil))) + +(define-test format-f.single-integer-valued + (:tag :format-f :single-float) + ;; Integer-valued singles get ".0" forced. + (assert-equal "1.0" + (lisp::format-f 1f0 nil nil 0 nil nil nil)) + (assert-equal "100.0" + (lisp::format-f 100f0 nil nil 0 nil nil nil)) + (assert-equal "1000000.0" + (lisp::format-f 1000000f0 nil nil 0 nil nil nil))) + +(define-test format-f.single-width-fits + (:tag :format-f :single-float) + (assert-equal " 3.14" + (lisp::format-f 3.14f0 10 nil 0 nil nil nil))) + +(define-test format-f.single-negative-zero + (:tag :format-f :single-float) + (assert-equal "-0.0" + (lisp::format-f (- 0f0) nil nil 0 nil nil nil)) + (assert-equal "+0.0" + (lisp::format-f 0f0 nil nil 0 nil nil t))) + +;;; ---------------------------------------------------------------------- +;;; ~G single-float + +(define-test format-g.single-basic + (:tag :format-g :single-float) + ;; ~F-form path for value in normal range. + (assert-equal "3.1415927 " + (lisp::format-g 3.1415927f0 nil nil nil 1 nil nil #\f nil)) + (assert-equal "0. " + (lisp::format-g 0f0 nil nil nil 1 nil nil #\f nil)) + (assert-equal "-0. " + (lisp::format-g (- 0f0) nil nil nil 1 nil nil #\f nil))) + +(define-test format-g.single-large-uses-e + (:tag :format-g :single-float) + ;; Large values fall to ~E form. effective-d for f2s shortest + ;; depends on the digit count, but for 1e10f0 it's small. + ;; 1e10f0 has n=11, q small, dd negative -> ~E form. + (let ((s (lisp::format-g 1f10 nil nil nil 1 nil nil #\f nil))) + (assert-true (search "f+10" s) s))) + +(define-test format-g.single-small-uses-e + (:tag :format-g :single-float) + (let ((s (lisp::format-g 1f-5 nil nil nil 1 nil nil #\f nil))) + (assert-true (search "f-5" s) s))) + +(define-test format-g.single-d-given + (:tag :format-g :single-float) + ;; d-given uses the double path internally. + (assert-equal "3.1416 " + (lisp::format-g 3.1415927f0 nil 5 nil 1 nil nil #\f nil))) + +;;; ---------------------------------------------------------------------- +;;; Mixed-type sanity checks + +(define-test format-e.mixed-types + (:tag :format-e :single-float) + ;; Same nominal value, different float types -- should produce + ;; different shortest forms. + (let ((single-out (lisp::format-e 3.14f0 nil nil nil 1 nil nil #\f nil)) + (double-out (lisp::format-e 3.14d0 nil nil nil 1 nil nil #\d nil))) + (assert-true (search "f" single-out) single-out) + (assert-true (search "d" double-out) double-out))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2722dfe9cdf6d53245a76d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2722dfe9cdf6d53245a76d… 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