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/2722dfe9cdf6d53245a76d0... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2722dfe9cdf6d53245a76d0... 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