GitLab

at 2026-05-24T06:39:55-07:00

Improve time and consing for format-f

`reshape-fixed` consed a new string with any decimal removed.  That's
gone now by doing basically what reshape-format-e does.

`emit-shortest` and `reshape-fixed` now accept a stream where the
result is written.  All the intermediate allocations are gone now.

Added `reshape-fixed-length` so that `emit-shortest` can compute the
appropriate field length without running reshape.

Profile results:  format-f is 11% faster.  Consing for non-nil d is
just 2% better, but d nil is 22% better.

10000 iterations × 11 sample values = 110000 format-f calls per impl.

| metric | original | after stream refactor | improvement |
|--------|---------:|----------------------:|------------:|
| format-f-fixed bytes/call | 368 | 87 | -76% |
| total time | 0.55 s | 0.49 s | -11% |
| total bytes | 56 MB | 55 MB | -2% |

| metric | original | after all changes | improvement |
|--------|---------:|------------------:|------------:|
| reshape-fixed bytes/call | 769 | 423 | -45% |
| emit-shortest bytes/call | 195 | 8 | **-96%** |
| format-f-free bytes/call | 109 | 24 | -78% |
| total time | 1.28 s | 1.14 s | -11% |
| total bytes | 135 MB | 105 MB | -22% |

- d-given: **4.5 µs/call**
- d-nil:   **10.4 µs/call**

@@ -2440,11 +2440,79 @@ radix-R.  If you have a power-list then pass it in as PL."
  		   do (write-char #\0 s))
  	     (write-string raw-digits s))))))
 +#+nil
  (defun reshape-fixed (mantissa-text exponent)
    (declare (type simple-string mantissa-text)
  	   (fixnum exponent))
    (reshape-format-e mantissa-text (1+ exponent) nil))
 +(defun reshape-fixed (stream mantissa-text exponent)
 +  "Adjust MANTISSA-TEXT is scaled exactly by 10^{EXPONENT} by moving the
 +  decimal point.  MANTISSA-TEXT is of the form 'd[.dddd]' from d2exp
 +  or d2s.  The scaled value is written to STREAM."
 +  (declare (type simple-string mantissa-text)
 +	   (fixnum exponent))
 +  (let ((k (1+ exponent)))
 +    ;; If exponent = 0, the mantissa is already the right value, but
 +    ;; we need to append ".0" if there's not dot in the mantissa.
 +    ;; This happens when d2s is given a small exact integral value.
 +    (when (zerop exponent)
 +      (write-string mantissa-text stream)
 +      (unless (find #\. mantissa-text)
 +	(write-string ".0" stream))
 +      (return-from reshape-fixed))
 +  (let* ((has-dot     (find #\. mantissa-text))
 +         (lead-char   (char mantissa-text 0))
 +	 ;; Where the stuff after the dot starts
 +         (tail-start  (if has-dot 2 1))
 +         (tail-len    (- (length mantissa-text) tail-start))
 +         (digit-count (1+ tail-len)))
 +    ;; Several cases to consider:
 +    ;;
 +    ;; * k is negative so the new dot preceeds the mantissa.  Pad with
 +    ;;   zeroes.
 +    ;; * k is so large that the dot is past the rightmost part of the
 +    ;;   mantissa.  Append enough zeroes and then add ".0"
 +    ;; * k is somewhere in the mantissa.  Handling of this case
 +    ;;   depends on if the new dot is to the left or to the right of
 +    ;;   the original dot.
 +    (cond
 +      ;; Case 2: new dot at or before position 0.
 +      ((<= k 0)
 +       (write-string "0." stream)
 +       ;; Insert zeros after the decimal but before the mantissa.
 +       (loop repeat (- k)
 +	     do (write-char #\0 stream))
 +       ;; Insert the mantissa, skipping the existing dot.
 +       (write-char lead-char stream)
 +       (when (plusp tail-len)
 +         (write-string mantissa-text stream :start tail-start)))
 +      ;; Case 1b: 1 < k < digit-count.  Move dot right by (k-1).
 +      ((< k digit-count)
 +       ;; Output the original mantissa up to the original dot.
 +       (write-char lead-char stream)
 +       (write-string mantissa-text stream
 +                     :start tail-start
 +                     :end (+ tail-start k -1))
 +       ;; Output the new dot.
 +       (write-char #\. stream)
 +       ;; Output everything after the original dot.
 +       (write-string mantissa-text stream
 +		     :start (+ tail-start k -1)))
 +      ;; Case 3: k >= digit-count.  Pad with zeros, force ".0".
 +      (t
 +       ;; Output the original mantissa, then everything after the
 +       ;; dot (if there was one).
 +       (write-char lead-char stream)
 +       (when (plusp tail-len)
 +         (write-string mantissa-text stream :start tail-start))
 +       ;; Pad with 0's
 +       (loop repeat (- k digit-count)
 +	     do (write-char #\0 stream))
 +       ;; Finish with ".0".
 +       (write-string ".0" stream))))))
++
++
  #+nil
  (defun emit-shortest (mantissa-text exponent is-negative-p w overflowchar padchar at-sign-p)
    (let* ((reshaped (reshape-fixed mantissa-text exponent))
@@ -2454,15 +2522,36 @@ radix-R.  If you have a power-list then pass it in as PL."
  	 (field (concatenate 'string sign-text reshaped)))
      (format-f-pad-overflow field w overflowchar padchar)))
 +(defun reshape-fixed-length (digit-count exponent)
 +  (let ((k (1+ exponent)))
 +    (cond ((zerop exponent)
 +	   ;; Fast path
 +	   (if (= digit-count 1)
 +	       3
 +	       (1+ digit-count)))
 +	  ((<= k 0)
 +	   ;; "0." + |k| zeros + digits
 +	   (+ 2 (- k) digit-count))
 +	  ((< k digit-count)
 +	   ;; "ddd.ddd"; add one for the dot.
 +	   (1+ digit-count))
 +	  (t
 +	   ;; "ddddd.0"; k digits + ".0"
 +	   (+ k 2)))))
++
  (defun emit-shortest (stream mantissa exponent is-negative-p w
                        overflowchar padchar at-sign-p)
 -  (let* ((reshaped  (reshape-fixed mantissa exponent))
 +  (let* ((has-dot (find #\. mantissa))
 +	 ;; Number of digits, not including the decimal point.
 +	 (digit-count (- (length mantissa)
 +			 (if has-dot 1 0)))
           (sign-len  (if (or is-negative-p at-sign-p) 1 0))
 -         (field-len (+ sign-len (length reshaped))))
 +	 (reshaped-len (reshape-fixed-length digit-count exponent))
 +         (field-len (+ sign-len reshaped-len)))
      (flet ((write-field ()
               (cond (is-negative-p (write-char #\- stream))
                     (at-sign-p     (write-char #\+ stream)))
 -             (write-string reshaped stream)))
 +             (reshape-fixed stream mantissa exponent)))
        (declare (dynamic-extent #'write-field))
        (pad-overflow stream field-len w overflowchar padchar #'write-field))))

Raymond Toy pushed to branch rtoy-ryu-printf at cmucl / cmucl

Commits:

2 changed files:

Changes: