Raymond Toy pushed to branch rtoy-ryu-printf at cmucl / cmucl Commits: 0f4741bc by Raymond Toy at 2026-05-24T07:13:55-07:00 Remove old code that's commented out Update cmucl.pot. - - - - - 2 changed files: - src/code/print.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/print.lisp ===================================== @@ -2457,135 +2457,6 @@ radix-R. If you have a power-list then pass it in as PL." (declare (dynamic-extent #'writ-field)) (pad-overflow stream field-len w overflowchar padchar #'write-field)))) - -#+nil -(defun reshape-fixed (raw-digits exponent) - ;; RAW-DIGITS is a string of digits with no sign or decimal point. - (declare (simple-string raw-digits) - (fixnu exponent)) - (let* ((digit-count (length raw-digits)) - (left-count (1+ exponent))) - (cond ((>= left-count digit-count) - ;; All digits go in the integer part; pad with trailing - ;; zeros - (concatenate 'string - raw-digits - (make-string (- left-count digit-count) - :initial-element #\0) - ".0")) - ((plusp left-count) - (concatenate 'string - (subseq raw-digits 0 left-count) - "." - (subseq raw-digits left-count))) - (t - ;; All digits go in the fractional part; prepend "0." and - ;; any needed leading zeroes. - (concatenate 'string - "0." - (make-string (- left-count) :initial-element #\0) - raw-digits))))) - -#+nil -(defun reshape-fixed (raw-digits exponent) - ;; RAW-DIGITS is a string of digits with no sign or decimal point. - (declare (simple-string raw-digits) - (fixnum exponent)) - (let* ((digit-count (length raw-digits)) - (left-count (1+ exponent))) - (with-output-to-string (s) - (cond ((>= left-count digit-count) - ;; All digits go in the integer part; pad with trailing - ;; zeros - (write-string raw-digits s) - (loop for k from 0 below (- left-count digit-count) - do (write-char #\0 s)) - (write-string ".0" s)) - ((plusp left-count) - (write-string raw-digits s :start 0 :end left-count) - (write-char #\. s) - (write-string raw-digits s :start left-count)) - (t - ;; All digits go in the fractional part; prepend "0." and - ;; any needed leading zeroes. - (write-string "0." s) - (loop for k from 0 below (- left-count) - 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)) - -#+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)))))) - (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 @@ -2593,15 +2464,6 @@ radix-R. If you have a power-list then pass it in as PL." (scale-mantissa stream mantissa-text (1+ exponent) nil)) -#+nil -(defun emit-shortest (mantissa-text exponent is-negative-p w overflowchar padchar at-sign-p) - (let* ((reshaped (reshape-fixed mantissa-text exponent)) - (sign-text (cond (is-negative-p "-") - (at-sign-p "+") - (t ""))) - (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) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -7731,10 +7731,6 @@ msgid "" " before all digits; K=1 leaves it at the original position." msgstr "" -#: src/code/print.lisp -msgid "Execution of a form compiled with errors:~% ~S" -msgstr "" - #: src/code/print.lisp msgid "" "Apply width/pad/overflow rules. FIELD-WRITER is a thunk of zero\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0f4741bc6989c434177786c2... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0f4741bc6989c434177786c2... 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