Fixed infinite printing loop

When libmpfr wasn't available, the function created by `make-not-available'
would try to print any _mpfr arguments, which would call the custom _mpfr
printer, which would try to use a libmpfr function, which would call the
function created by `make-not-available', which would try to print...
This commit is contained in:
Neil Toronto 2012-12-07 11:45:06 -07:00
parent 8fc0aedb6b
commit fff521212f
2 changed files with 26 additions and 15 deletions

View File

@ -8,12 +8,17 @@
(provide (provide
_mp_size_t _mp_size_t
_mp_limb_t _mp_limb_t
_mp_bitcnt_t
sizeof-mp_limb_t sizeof-mp_limb_t
gmp-limb-bits gmp-limb-bits
_mpz
_mpz-pointer _mpz-pointer
(struct-out mpz)
new-mpz new-mpz
integer->mpz integer->mpz
mpz->integer) mpz->integer
;; Low-level
gmp-lib)
;; =================================================================================================== ;; ===================================================================================================
;; Setup ;; Setup

View File

@ -548,20 +548,26 @@ There's no reason to allocate new limbs for an _mpfr without changing its precis
(if (zero? (mpfr-set-str y bs 10 'nearest)) y #f)])) (if (zero? (mpfr-set-str y bs 10 'nearest)) y #f)]))
(define (bigfloat-custom-write x port mode) (define (bigfloat-custom-write x port mode)
(write-string (cond
(cond [(bfzero? x) (if (= 0 (bigfloat-signbit x)) "0.bf" "-0.bf")] [(and mpfr-lib gmp-lib)
[(bfrational? x) ;; Only try to print if libmpfr was loaded; otherwise, we get an infinite loop when the
(define str (bigfloat->string x)) ;; `make-not-available' handler tries to print any _mpfr arguments
(cond [(regexp-match #rx"\\.|e" str) (write-string
(define exp (bigfloat-exponent x)) (cond [(bfzero? x) (if (= 0 (bigfloat-signbit x)) "0.bf" "-0.bf")]
(define prec (bigfloat-precision x)) [(bfrational? x)
(if ((abs exp) . > . (* prec 2)) (define str (bigfloat->string x))
(format "(bf \"~a\")" str) (cond [(regexp-match #rx"\\.|e" str)
(format "(bf #e~a)" str))] (define exp (bigfloat-exponent x))
[else (format "(bf ~a)" str)])] (define prec (bigfloat-precision x))
[(bfinfinite? x) (if (= 0 (bigfloat-signbit x)) "+inf.bf" "-inf.bf")] (if ((abs exp) . > . (* prec 2))
[else "+nan.bf"]) (format "(bf \"~a\")" str)
port)) (format "(bf #e~a)" str))]
[else (format "(bf ~a)" str)])]
[(bfinfinite? x) (if (= 0 (bigfloat-signbit x)) "+inf.bf" "-inf.bf")]
[else "+nan.bf"])
port)]
[else
(write-string "#<_mpfr>" port)]))
;; =================================================================================================== ;; ===================================================================================================
;; Main bigfloat constructor ;; Main bigfloat constructor