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

Commits:

3 changed files:

Changes:

  • src/code/print.lisp
    ... ... @@ -2001,15 +2001,21 @@ radix-R. If you have a power-list then pass it in as PL."
    2001 2001
    2002 2002
    2003 2003 
     ;;; Ryu interface
    2004 
    +
    2005 
    +;; This could be larger, but that would mean larger stack size for the
    2006 
    +;; foreign call.  This should be large enough for practical use.
    2004 2007 
     (defconstant +d2fixed-max-precision+
    2005 
    -  64
    2006 
    -  "")
    2008 
    +  1000
    2009 
    +  "Maximum precision (fractional digits for d2fixed.")
    2007 2010
    2008 2011 
     (defconstant +d2fixed-buffer-size+
    2012 
    +  ;; +320 to account for 300 ingeger digts + sign + dot + terminator +
    2013 
    +  ;; slack.
    2009 2014 
       (+ +d2fixed-max-precision+ 320)
    2010 
    -  "")
    2015 
    +  "Buffer size for d2fixed.")
    2011 2016
    2012 2017 
     (defun d2fixed (d precision)
    2018 
    +  "Lisp interface to Ryu d2fixed routine (specically d2fixed_buffered)"
    2013 2019 
       (declare (double-float d)
    2014 2020 
     	   (type (integer 0 #.+d2fixed-max-precision+) precision))
    2015 2021 
       (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."
    2025 2031 
         (alien:cast buf c-call:c-string)))
    2026 2032
    2027 2033 
     (defun d2exp (d precision)
    2034 
    +  "Lisp interface to Ryu d2exp (specifically d2exp-buffered)."
    2028 2035 
       (declare (double-float d)
    2029 2036 
     	   (type (integer 0 #.+d2fixed-max-precision+) precision))
    2030 2037 
       (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."
    2040 2047 
         (alien:cast buf c-call:c-string)))
    2041 2048
    2042 2049 
     (defun d2s (d)
    2050 
    +  "Lisp interface to Ryu d2s (specifically d2s_buffered"
    2043 2051 
       (declare (double-float d))
    2044 2052 
       (alien:with-alien ((buf (alien:array c-call:char #.+d2fixed-buffer-size+)))
    2045 2053 
         (alien:alien-funcall
    ... ... @@ -2051,6 +2059,27 @@ radix-R. If you have a power-list then pass it in as PL."
    2051 2059 
          (alien:cast buf (* c-call:char)))
    2052 2060 
         (alien:cast buf c-call:c-string)))
    2053 2061
    2062 
    +(defun f2s (s)
    2063 
    +  (declare (single-float s))
    2064 
    +  (alien:with-alien ((buf (alien:array c-call:char 16)))
    2065 
    +    (alien:alien-funcall
    2066 
    +     (alien:extern-alien "f2s_buffered"
    2067 
    +                         (function c-call:void
    2068 
    +                                   c-call:float
    2069 
    +                                   (* c-call:char)))
    2070 
    +     s
    2071 
    +     (alien:cast buf (* c-call:char)))
    2072 
    +    (alien:cast buf c-call:c-string)))
    2073 
    +
    2074 
    +(declaim (inline float-to-string))
    2075 
    +(defun float-to-string (f)
    2076 
    +  "Convert F, a single-float or double-float, to a string of the shortest
    2077 
    +  form."
    2078 
    +  (declare (type (or single-float double-float) f))
    2079 
    +  (etypecase f
    2080 
    +    (double-float (d2s (abs f)))
    2081 
    +    (single-float (f2s (abs f)))))
    2082 
    +
    2054 2083 
     (defun parsed-d2exp (pos-x digits)
    2055 2084 
       (let* ((raw (d2exp pos-x digits))
    2056 2085 
     	 ;; 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."
    2260 2289 
           (pad-overflow stream field-len w overflowchar padchar #'write-field))))
    2261 2290
    2262 2291 
     (defun format-e (value w d e k overflowchar padchar exponentchar at-sign-p)
    2263 
    -  (declare (double-float value)
    2292 
    +  (declare (type (or single-float double-float) value)
    2264 2293 
                (fixnum k)
    2265 2294 
                (type (or null (and unsigned-byte fixnum)) w d e)
    2266 2295 
                (optimize (speed 3)))
    2267 
    -  (let* ((is-negative-p (minusp (float-sign value)))
    2268 
    -         (abs-value (abs value)))
    2296 
    +  (multiple-value-bind (is-negative-p abs-value)
    2297 
    +      (etypecase value
    2298 
    +	(double-float
    2299 
    +	 (values (minusp (float-sign value))
    2300 
    +		 (abs value)))
    2301 
    +	(single-float
    2302 
    +	 (values (minusp (float-sign value))
    2303 
    +		 (abs (float value 1d0)))))
    2269 2304 
         (with-output-to-string (stream)
    2270 2305 
           (cond
    2271 2306 
             (d
    2272 2307 
              (multiple-value-bind (mantissa exponent)
    2273 
    -             (parsed-exp-form (d2exp abs-value (d2exp-precision d k)))
    2308 
    +             (parsed-exp-form (d2exp abs-value
    2309 
    +				     (d2exp-precision d k)))
    2274 2310 
                (format-e-string stream mantissa exponent is-negative-p
    2275 2311 
                                 w e k overflowchar padchar exponentchar at-sign-p nil)))
    2276 2312 
             (t
    2277 2313 
              (multiple-value-bind (mantissa exponent)
    2278 
    -             (parsed-exp-form (d2s abs-value))
    2314 
    +             (parsed-exp-form (float-to-string value))
    2279 2315 
                (let* ((actual-exp (- exponent (1- k)))
    2280 2316 
                       (full-len (compute-exp-output-length mantissa actual-exp k e
    2281 2317 
                                                            is-negative-p at-sign-p
    ... ... @@ -2291,7 +2327,8 @@ radix-R. If you have a power-list then pass it in as PL."
    2291 2327 
                            (drop-zero-p (and d-fit (<= k 0))))
    2292 2328 
                       (if d-fit
    2293 2329 
                           (multiple-value-bind (mantissa exponent)
    2294 
    -                          (parsed-exp-form (d2exp abs-value (d2exp-precision d-fit k)))
    2330 
    +                          (parsed-exp-form (d2exp abs-value
    2331 
    +						  (d2exp-precision d-fit k)))
    2295 2332 
                             (format-e-string stream mantissa exponent is-negative-p
    2296 2333 
                                              w e k overflowchar padchar exponentchar at-sign-p
    2297 2334 
                                              drop-zero-p))
    ... ... @@ -2322,6 +2359,7 @@ radix-R. If you have a power-list then pass it in as PL."
    2322 2359
    2323 2360 
     (defun format-f-fixed (stream abs-value is-negative-p w d
    2324 2361 
                            overflowchar padchar at-sign-p)
    2362 
    +  (declare (double-float abs-value))
    2325 2363 
       (let* ((raw-string (d2fixed abs-value d))
    2326 2364 
              (raw-len    (length raw-string))
    2327 2365 
              (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."
    2370 2408 
           (declare (dynamic-extent #'write-field))
    2371 2409 
           (pad-overflow stream field-len w overflowchar padchar #'write-field))))
    2372 2410
    2373 
    -(defun format-f-free (stream abs-value is-negative-p w
    2411 
    +(defun format-f-free (stream value is-negative-p w
    2374 2412 
                           overflowchar padchar at-sign-p)
    2413 
    +  (declare (type (or single-float double-float) value))
    2375 2414 
       (multiple-value-bind (mantissa exponent)
    2376 
    -      (parsed-exp-form (d2s abs-value))
    2415 
    +      (parsed-exp-form (float-to-string value))
    2377 2416 
         (let* ((has-dot     (find #\. mantissa))
    2378 2417 
                (digit-count (if has-dot (1- (length mantissa)) (length mantissa)))
    2379 2418 
                (int-len     (max 1 (1+ exponent)))
    ... ... @@ -2391,15 +2430,24 @@ radix-R. If you have a power-list then pass it in as PL."
    2391 2430 
                     (emit-shortest stream mantissa exponent is-negative-p w
    2392 2431 
                                    overflowchar padchar at-sign-p))))
    2393 2432 
             (t
    2394 
    -         (format-f-fixed stream abs-value is-negative-p w d-fit
    2395 
    -                         overflowchar padchar at-sign-p))))))
    2433 
    +	 (let ((abs-value (etypecase value
    2434 
    +			    (double-float (abs value))
    2435 
    +			    (single-float (abs value)))))
    2436 
    +           (format-f-fixed stream abs-value is-negative-p w d-fit
    2437 
    +                           overflowchar padchar at-sign-p)))))))
    2396 2438
    2397 2439 
     (defun format-f (value w d k overflowchar padchar at-sign-p)
    2398 
    -  (declare (double-float value)
    2440 
    +  (declare (type (or single-float double-float) value)
    2399 2441 
     	   (fixnum k)
    2400 2442 
     	   (type (or null (and unsigned-byte fixnum)) w d))
    2401 
    -  (let ((is-negative-p (minusp (float-sign value)))
    2402 
    -	(abs-value (abs value)))
    2443 
    +  (multiple-value-bind (is-negative-p abs-value)
    2444 
    +      (etypecase value
    2445 
    +	(double-float
    2446 
    +	 (values (minusp (float-sign value))
    2447 
    +		 (abs value)))
    2448 
    +	(single-float
    2449 
    +	 (values (minusp (float-sign value))
    2450 
    +		 (abs (float value 1d0)))))
    2403 2451 
         (with-output-to-string (s)
    2404 2452 
           (cond ((not (zerop k))
    2405 2453 
     	     ;;  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."
    2413 2461 
     	    (t
    2414 2462 
     	     ;; No d, so use d2s to get the shortest digits; convert by
    2415 2463 
     	     ;; placing the decimal poin at the right spot.
    2416 
    -	     (format-f-free s abs-value is-negative-p  w overflowchar padchar at-sign-p))))))
    2464 
    +	     (format-f-free s value is-negative-p  w overflowchar padchar at-sign-p))))))
    2417 2465
    2418 2466 
     ;;; Ryu ~G
    2419 2467 
     (defun format-g (value w d e k overflowchar padchar exponentchar at-sign-p)
    2420 
    -  (declare (double-float value)
    2468 
    +  (declare (type (or single-float double-float) value)
    2421 2469 
     	   (fixnum k)
    2422 2470 
     	   (type (or null (and unsigned-byte fixnum)) w d e))
    2423 2471 
       (multiple-value-bind (mantissa exponent)
    2424 
    -      (parsed-exp-form (d2s (abs value)))
    2472 
    +      (parsed-exp-form (float-to-string value))
    2425 2473 
         (let* ((digit-count (length (remove #\. mantissa)))
    2426 2474 
     	   (n (1+ exponent))
    2427 2475 
     	   (effective-d (or d (max digit-count (min n 7))))

  • src/i18n/locale/cmucl.pot
    No preview for this file type
  • tests/ryu.lisp
    ... ... @@ -602,3 +602,184 @@
    602 602 
       ;; follow CLHS literally.
    603 603 
       (assert-equal "3.14    "
    604 604 
                     (lisp::format-g 3.14d0 3 nil nil 1 #\* nil #\d nil)))
    605 
    +
    606 
    +
    607 
    +;;;; Single-float tests for format-e, format-f, format-g.
    608 
    +;;;;
    609 
    +;;;; The shortest-form (d-nil) paths use f2s and may produce different
    610 
    +;;;; digits than d2s would for the corresponding double-float value,
    611 
    +;;;; since the shortest round-trip representation depends on float
    612 
    +;;;; precision.  The d-given paths widen to double and use d2fixed/
    613 
    +;;;; d2exp; results match the double-float case at that precision.
    614 
    +
    615 
    +(define-test format-e.single-basic
    616 
    +  (:tag :format-e :single-float)
    617 
    +  ;; Default ~E exponent marker for single-floats is 'f' (matches
    618 
    +  ;; CL's single-float-format default).
    619 
    +  (assert-equal "3.1415927f+0"
    620 
    +                (lisp::format-e 3.1415927f0 nil nil nil 1 nil nil #\f nil))
    621 
    +  (assert-equal "-3.1415927f+0"
    622 
    +                (lisp::format-e -3.1415927f0 nil nil nil 1 nil nil #\f nil))
    623 
    +  (assert-equal "1.0f+0"
    624 
    +                (lisp::format-e 1f0 nil nil nil 1 nil nil #\f nil))
    625 
    +  (assert-equal "1.0f-1"
    626 
    +                (lisp::format-e 0.1f0 nil nil nil 1 nil nil #\f nil)))
    627 
    +
    628 
    +(define-test format-e.single-d-given
    629 
    +  (:tag :format-e :single-float)
    630 
    +  ;; d-given path: widens to double, calls d2exp.  At precision 5,
    631 
    +  ;; matches what d2exp produces for the exact double representation
    632 
    +  ;; of the single value.
    633 
    +  (assert-equal "3.14159f+0"
    634 
    +                (lisp::format-e 3.1415927f0 nil 5 nil 1 nil nil #\f nil))
    635 
    +  (assert-equal "5.00000f-1"
    636 
    +                (lisp::format-e 0.5f0 nil 5 nil 1 nil nil #\f nil)))
    637 
    +
    638 
    +(define-test format-e.single-shortest-differs-from-double
    639 
    +  (:tag :format-e :single-float)
    640 
    +  ;; The single-float path uses f2s, which gives the shortest form
    641 
    +  ;; for the single-precision value.  Widening to double first would
    642 
    +  ;; produce a different (longer) shortest form because the widened
    643 
    +  ;; value 0.10000000149011612d0 is not the same as 0.1d0.
    644 
    +  (assert-equal "1.0f-1"
    645 
    +                (lisp::format-e 0.1f0 nil nil nil 1 nil nil #\f nil))
    646 
    +  ;; Confirm: if you widened first, d2s on the result would give:
    647 
    +  (assert-equal "1.0000000149011612f-1"
    648 
    +                (lisp::format-e 0.10000000149011612d0 nil nil nil 1 nil nil #\f nil)))
    649 
    +
    650 
    +
    651 
    +(define-test format-e.single-boundary
    652 
    +  (:tag :format-e :single-float)
    653 
    +  ;; Single-float bounds.
    654 
    +  (let ((maxs (lisp::format-e most-positive-single-float
    655 
    +                              nil nil nil 1 nil nil #\f nil)))
    656 
    +    (assert-true (search "f+38" maxs) maxs))
    657 
    +  (let ((mins (lisp::format-e least-positive-single-float
    658 
    +                              nil nil nil 1 nil nil #\f nil)))
    659 
    +    (assert-true (search "f-45" mins) mins)))
    660 
    +
    661 
    +(define-test format-e.single-negative-zero
    662 
    +  (:tag :format-e :single-float)
    663 
    +  (assert-equal "-0.0f+0"
    664 
    +                (lisp::format-e (- 0f0) nil nil nil 1 nil nil #\f nil))
    665 
    +  (assert-equal "+0.0f+0"
    666 
    +                (lisp::format-e 0f0 nil nil nil 1 nil nil #\f t)))
    667 
    +
    668 
    +;;; ----------------------------------------------------------------------
    669 
    +;;; ~F single-float
    670 
    +
    671 
    +(define-test format-f.single-basic
    672 
    +  (:tag :format-f :single-float)
    673 
    +  (assert-equal "3.14"
    674 
    +                (lisp::format-f 3.14159f0 nil 2 0 nil nil nil))
    675 
    +  (assert-equal "-3.14"
    676 
    +                (lisp::format-f -3.14159f0 nil 2 0 nil nil nil))
    677 
    +  (assert-equal "1.00000"
    678 
    +                (lisp::format-f 1f0 nil 5 0 nil nil nil)))
    679 
    +
    680 
    +(define-test format-f.single-d-nil
    681 
    +  (:tag :format-f :single-float)
    682 
    +  ;; Shortest path: f2s output for single-floats is shorter than
    683 
    +  ;; d2s would be for the widened value.
    684 
    +  (assert-equal "3.1415927"
    685 
    +                (lisp::format-f 3.1415927f0 nil nil 0 nil nil nil))
    686 
    +  (assert-equal "1.0"
    687 
    +                (lisp::format-f 1f0 nil nil 0 nil nil nil))
    688 
    +  (assert-equal "0.1"
    689 
    +                (lisp::format-f 0.1f0 nil nil 0 nil nil nil))
    690 
    +  (assert-equal "0.5"
    691 
    +                (lisp::format-f 0.5f0 nil nil 0 nil nil nil)))
    692 
    +
    693 
    +(define-test format-f.single-d-nil-vs-double
    694 
    +  (:tag :format-f :single-float)
    695 
    +  ;; Confirm that the single-float path uses f2s, not d2s on a
    696 
    +  ;; widened value.  For 0.1f0, f2s gives "1" at exp -1, so output
    697 
    +  ;; is "0.1".  If we widened first, d2s on the resulting double
    698 
    +  ;; would give a longer shortest form.
    699 
    +  (assert-equal "0.1"
    700 
    +                (lisp::format-f 0.1f0 nil nil 0 nil nil nil))
    701 
    +  ;; Same numeric value, but as a double-float literal -- d2s gives
    702 
    +  ;; the long shortest form that round-trips through double.
    703 
    +  (assert-equal "0.10000000149011612"
    704 
    +                (lisp::format-f 0.10000000149011612d0 nil nil 0 nil nil nil))
    705 
    +  ;; And 0.1d0 (the double literal nearest to 0.1) has its own
    706 
    +  ;; shortest form, which IS "0.1" since 0.1d0 is the canonical
    707 
    +  ;; double for that decimal.
    708 
    +  (assert-equal "0.1"
    709 
    +                (lisp::format-f 0.1d0 nil nil 0 nil nil nil)))
    710 
    +
    711 
    +
    712 
    +(define-test format-f.single-leading-zeros
    713 
    +  (:tag :format-f :single-float)
    714 
    +  ;; Small singles still need leading-zero handling.
    715 
    +  (assert-equal "0.001"
    716 
    +                (lisp::format-f 0.001f0 nil nil 0 nil nil nil))
    717 
    +  (assert-equal "0.00001"
    718 
    +                (lisp::format-f 0.00001f0 nil nil 0 nil nil nil)))
    719 
    +
    720 
    +(define-test format-f.single-integer-valued
    721 
    +  (:tag :format-f :single-float)
    722 
    +  ;; Integer-valued singles get ".0" forced.
    723 
    +  (assert-equal "1.0"
    724 
    +                (lisp::format-f 1f0 nil nil 0 nil nil nil))
    725 
    +  (assert-equal "100.0"
    726 
    +                (lisp::format-f 100f0 nil nil 0 nil nil nil))
    727 
    +  (assert-equal "1000000.0"
    728 
    +                (lisp::format-f 1000000f0 nil nil 0 nil nil nil)))
    729 
    +
    730 
    +(define-test format-f.single-width-fits
    731 
    +  (:tag :format-f :single-float)
    732 
    +  (assert-equal "      3.14"
    733 
    +                (lisp::format-f 3.14f0 10 nil 0 nil nil nil)))
    734 
    +
    735 
    +(define-test format-f.single-negative-zero
    736 
    +  (:tag :format-f :single-float)
    737 
    +  (assert-equal "-0.0"
    738 
    +                (lisp::format-f (- 0f0) nil nil 0 nil nil nil))
    739 
    +  (assert-equal "+0.0"
    740 
    +                (lisp::format-f 0f0 nil nil 0 nil nil t)))
    741 
    +
    742 
    +;;; ----------------------------------------------------------------------
    743 
    +;;; ~G single-float
    744 
    +
    745 
    +(define-test format-g.single-basic
    746 
    +  (:tag :format-g :single-float)
    747 
    +  ;; ~F-form path for value in normal range.
    748 
    +  (assert-equal "3.1415927    "
    749 
    +                (lisp::format-g 3.1415927f0 nil nil nil 1 nil nil #\f nil))
    750 
    +  (assert-equal "0.    "
    751 
    +                (lisp::format-g 0f0 nil nil nil 1 nil nil #\f nil))
    752 
    +  (assert-equal "-0.    "
    753 
    +                (lisp::format-g (- 0f0) nil nil nil 1 nil nil #\f nil)))
    754 
    +
    755 
    +(define-test format-g.single-large-uses-e
    756 
    +  (:tag :format-g :single-float)
    757 
    +  ;; Large values fall to ~E form.  effective-d for f2s shortest
    758 
    +  ;; depends on the digit count, but for 1e10f0 it's small.
    759 
    +  ;; 1e10f0 has n=11, q small, dd negative -> ~E form.
    760 
    +  (let ((s (lisp::format-g 1f10 nil nil nil 1 nil nil #\f nil)))
    761 
    +    (assert-true (search "f+10" s) s)))
    762 
    +
    763 
    +(define-test format-g.single-small-uses-e
    764 
    +  (:tag :format-g :single-float)
    765 
    +  (let ((s (lisp::format-g 1f-5 nil nil nil 1 nil nil #\f nil)))
    766 
    +    (assert-true (search "f-5" s) s)))
    767 
    +
    768 
    +(define-test format-g.single-d-given
    769 
    +  (:tag :format-g :single-float)
    770 
    +  ;; d-given uses the double path internally.
    771 
    +  (assert-equal "3.1416    "
    772 
    +                (lisp::format-g 3.1415927f0 nil 5 nil 1 nil nil #\f nil)))
    773 
    +
    774 
    +;;; ----------------------------------------------------------------------
    775 
    +;;; Mixed-type sanity checks
    776 
    +
    777 
    +(define-test format-e.mixed-types
    778 
    +  (:tag :format-e :single-float)
    779 
    +  ;; Same nominal value, different float types -- should produce
    780 
    +  ;; different shortest forms.
    781 
    +  (let ((single-out (lisp::format-e 3.14f0 nil nil nil 1 nil nil #\f nil))
    782 
    +        (double-out (lisp::format-e 3.14d0 nil nil nil 1 nil nil #\d nil)))
    783 
    +    (assert-true (search "f" single-out) single-out)
    784 
    +    (assert-true (search "d" double-out) double-out)))
    785 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help Notification message regarding https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2722dfe9cdf6d53245a76d0c6e1775314af6e48e...683edf58d28657eaa5204d521ad04a8488a0f996 at 1779657294