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
-
cf9d41e9
by Raymond Toy at 2026-05-25T07:10:10-07:00
3 changed files:
Changes:
| ... | ... | @@ -1585,7 +1585,7 @@ |
| 1585 | 1585 | ((and lisp::*use-ryu-printer*
|
| 1586 | 1586 | (or (null k) (zerop k))
|
| 1587 | 1587 | (typep number '(or single-float double-float)))
|
| 1588 | - (format-fixed-ryu stream number w d (or k 0) ovf pad atsign))
|
|
| 1588 | + (format-fixed-ryu stream number w d k ovf pad atsign))
|
|
| 1589 | 1589 | (t
|
| 1590 | 1590 | (format-fixed-aux-bd stream number w d k ovf pad atsign))))
|
| 1591 | 1591 | |
| ... | ... | @@ -1599,7 +1599,7 @@ |
| 1599 | 1599 | (prin1 number stream)
|
| 1600 | 1600 | nil)
|
| 1601 | 1601 | (t
|
| 1602 | - (write-string (lisp::format-f number w d k ovf pad atsign) stream)))
|
|
| 1602 | + (write-string (lisp::format-f number w d (or k 0) ovf pad atsign) stream)))
|
|
| 1603 | 1603 | nil)
|
| 1604 | 1604 | |
| 1605 | 1605 | (defun format-fixed-aux-bd (stream number w d k ovf pad atsign)
|
| ... | ... | @@ -412,11 +412,32 @@ |
| 412 | 412 | (raw-len (length raw-string))
|
| 413 | 413 | (sign-len (if (or is-negative-p at-sign-p) 1 0))
|
| 414 | 414 | (need-dot (zerop d))
|
| 415 | - (field-len (+ sign-len raw-len (if need-dot 1 0))))
|
|
| 415 | + (full-field-len (+ sign-len raw-len (if need-dot 1 0)))
|
|
| 416 | + ;; CLHS 22.3.3.1: the leading zero before the decimal point
|
|
| 417 | + ;; is optional when the magnitude is nonzero and less than 1.
|
|
| 418 | + ;; d2fixed always emits it (e.g. "0.50" for 0.5), so detect
|
|
| 419 | + ;; that case here and drop the zero if the field would not
|
|
| 420 | + ;; otherwise fit in W. For exact zero the leading digit is
|
|
| 421 | + ;; required, so PLUSP ABS-VALUE gates the dropping.
|
|
| 422 | + (lpoint-droppable
|
|
| 423 | + (and (plusp abs-value)
|
|
| 424 | + (>= raw-len 2)
|
|
| 425 | + (char= (char raw-string 0) #\0)
|
|
| 426 | + (char= (char raw-string 1) #\.)))
|
|
| 427 | + (drop-leading-zero-p
|
|
| 428 | + (and lpoint-droppable
|
|
| 429 | + w
|
|
| 430 | + (> full-field-len w)))
|
|
| 431 | + (field-len (if drop-leading-zero-p
|
|
| 432 | + (1- full-field-len)
|
|
| 433 | + full-field-len)))
|
|
| 416 | 434 | (flet ((write-field ()
|
| 417 | 435 | (cond (is-negative-p (write-char #\- stream))
|
| 418 | 436 | (at-sign-p (write-char #\+ stream)))
|
| 419 | - (write-string raw-string stream)
|
|
| 437 | + (cond (drop-leading-zero-p
|
|
| 438 | + (write-string raw-string stream :start 1))
|
|
| 439 | + (t
|
|
| 440 | + (write-string raw-string stream)))
|
|
| 420 | 441 | (when need-dot (write-char #\. stream))))
|
| 421 | 442 | (declare (dynamic-extent #'write-field))
|
| 422 | 443 | (pad-overflow stream field-len w overflowchar padchar #'write-field)))))
|
| ... | ... | @@ -482,17 +503,21 @@ |
| 482 | 503 | (d-fit (and w (- w sign-len int-len 1))))
|
| 483 | 504 | (cond
|
| 484 | 505 | ((or (null w) (>= d-fit shortest-d))
|
| 506 | + ;; No width or the shortest form fits within a field width
|
|
| 507 | + ;; of W.
|
|
| 485 | 508 | (emit-shortest stream mantissa exponent is-negative-p w
|
| 486 | 509 | overflowchar padchar at-sign-p))
|
| 487 | - ((minusp d-fit)
|
|
| 488 | - (cond (overflowchar
|
|
| 489 | - (loop repeat w do (write-char overflowchar stream)))
|
|
| 490 | - (t
|
|
| 491 | - (emit-shortest stream mantissa exponent is-negative-p w
|
|
| 492 | - overflowchar padchar at-sign-p))))
|
|
| 493 | - (t
|
|
| 494 | - (format-f-fixed stream value w d-fit
|
|
| 495 | - overflowchar padchar at-sign-p)))))))
|
|
| 510 | + (overflowchar
|
|
| 511 | + ;; Shortest form does not fit and OVERFLOWCHAR is set; fill
|
|
| 512 | + ;; the field with overflow characters.
|
|
| 513 | + (loop repeat w
|
|
| 514 | + do (write-char overflowchar stream)))
|
|
| 515 | + (t
|
|
| 516 | + ;; Shortest form does not fit and no OVERFLOWCHAR; emit the
|
|
| 517 | + ;; full shortest form, letting the field expand. CLHS
|
|
| 518 | + ;; 22.3.3.1 requires this.
|
|
| 519 | + (emit-shortest stream mantissa exponent is-negative-p w
|
|
| 520 | + overflowchar padchar at-sign-p)))))))
|
|
| 496 | 521 | |
| 497 | 522 | (defun format-f (value w d k overflowchar padchar at-sign-p)
|
| 498 | 523 | (declare (type (or single-float double-float) value)
|
| ... | ... | @@ -732,6 +732,68 @@ |
| 732 | 732 | (assert-equal " 3.14"
|
| 733 | 733 | (lisp::format-f 3.14f0 10 nil 0 nil nil nil)))
|
| 734 | 734 | |
| 735 | +(define-test format-f.single-narrow-width-no-overflow-char
|
|
| 736 | + (:tag :format-f :single-float)
|
|
| 737 | + ;; CLHS 22.3.3.1: when the shortest form does not fit in the
|
|
| 738 | + ;; specified width and no overflow character is supplied, the field
|
|
| 739 | + ;; expands rather than truncating digits. Round-trip and the
|
|
| 740 | + ;; "at least one digit after the decimal point" rule must both hold.
|
|
| 741 | + (assert-equal "1.0"
|
|
| 742 | + (lisp::format-f 1.0f0 2 nil 0 nil nil nil))
|
|
| 743 | + (assert-equal "1.0"
|
|
| 744 | + (lisp::format-f 1.0f0 1 nil 0 nil nil nil))
|
|
| 745 | + ;; Same for double-floats.
|
|
| 746 | + (assert-equal "1.0"
|
|
| 747 | + (lisp::format-f 1.0d0 2 nil 0 nil nil nil)))
|
|
| 748 | + |
|
| 749 | +(define-test format-f.single-narrow-width-with-overflow-char
|
|
| 750 | + (:tag :format-f :single-float)
|
|
| 751 | + ;; With overflowchar supplied, the field is filled with the overflow
|
|
| 752 | + ;; character when the shortest form does not fit.
|
|
| 753 | + (assert-equal "**"
|
|
| 754 | + (lisp::format-f 1.0f0 2 nil 0 #\* nil nil))
|
|
| 755 | + (assert-equal "***"
|
|
| 756 | + (lisp::format-f 1234.5f0 3 nil 0 #\* nil nil)))
|
|
| 757 | + |
|
| 758 | +(define-test format-f.optional-leading-zero
|
|
| 759 | + (:tag :format-f :single-float :double-float)
|
|
| 760 | + ;; CLHS 22.3.3.1: "a zero is printed before the decimal point if
|
|
| 761 | + ;; there is room". When the field is too narrow to fit the leading
|
|
| 762 | + ;; zero, it is dropped, and the output starts with the decimal point.
|
|
| 763 | + ;; ANSI tests FORMAT.F.13-16.
|
|
| 764 | + ;;
|
|
| 765 | + ;; ~3,2F of 0.5 -> ".50"
|
|
| 766 | + (assert-equal ".50" (lisp::format-f 0.5f0 3 2 0 nil nil nil))
|
|
| 767 | + (assert-equal ".50" (lisp::format-f 0.5d0 3 2 0 nil nil nil))
|
|
| 768 | + ;; ~2,1F of 0.5 -> ".5"
|
|
| 769 | + (assert-equal ".5" (lisp::format-f 0.5f0 2 1 0 nil nil nil))
|
|
| 770 | + (assert-equal ".5" (lisp::format-f 0.5d0 2 1 0 nil nil nil))
|
|
| 771 | + ;; ~4,2@F of 0.5 -> "+.50"
|
|
| 772 | + (assert-equal "+.50" (lisp::format-f 0.5f0 4 2 0 nil nil t))
|
|
| 773 | + (assert-equal "+.50" (lisp::format-f 0.5d0 4 2 0 nil nil t))
|
|
| 774 | + ;; ~2,2F of 0.5 -> ".50" (field expands beyond w=2 since no overflowchar)
|
|
| 775 | + (assert-equal ".50" (lisp::format-f 0.5f0 2 2 0 nil nil nil))
|
|
| 776 | + (assert-equal ".50" (lisp::format-f 0.5d0 2 2 0 nil nil nil))
|
|
| 777 | + ;; Negative values: ~3,2F of -0.5 -> "-.50" (field expands past w=3).
|
|
| 778 | + (assert-equal "-.50" (lisp::format-f -0.5d0 3 2 0 nil nil nil))
|
|
| 779 | + ;; -0.5 in width 4: drops the zero, fits exactly.
|
|
| 780 | + (assert-equal "-.50" (lisp::format-f -0.5d0 4 2 0 nil nil nil)))
|
|
| 781 | + |
|
| 782 | +(define-test format-f.leading-zero-kept-when-room
|
|
| 783 | + (:tag :format-f :single-float :double-float)
|
|
| 784 | + ;; When there is room for the leading zero, it must be printed.
|
|
| 785 | + (assert-equal " 0.50" (lisp::format-f 0.5d0 5 2 0 nil nil nil))
|
|
| 786 | + (assert-equal "0.50" (lisp::format-f 0.5d0 4 2 0 nil nil nil))
|
|
| 787 | + (assert-equal "0.50" (lisp::format-f 0.5d0 nil 2 0 nil nil nil)))
|
|
| 788 | + |
|
| 789 | +(define-test format-f.leading-zero-required-for-exact-zero
|
|
| 790 | + (:tag :format-f :single-float :double-float)
|
|
| 791 | + ;; CLHS 22.3.3.1: "If the magnitude is exactly zero, a single zero
|
|
| 792 | + ;; digit is printed before the decimal point." Don't drop it even
|
|
| 793 | + ;; if the field would overflow.
|
|
| 794 | + (assert-equal "0.00" (lisp::format-f 0.0d0 3 2 0 nil nil nil))
|
|
| 795 | + (assert-equal "0.00" (lisp::format-f 0.0f0 3 2 0 nil nil nil)))
|
|
| 796 | + |
|
| 735 | 797 | (define-test format-f.single-negative-zero
|
| 736 | 798 | (:tag :format-f :single-float)
|
| 737 | 799 | (assert-equal "-0.0"
|