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