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
_mp_size_t
_mp_limb_t
_mp_bitcnt_t
sizeof-mp_limb_t
gmp-limb-bits
_mpz
_mpz-pointer
(struct-out mpz)
new-mpz
integer->mpz
mpz->integer)
mpz->integer
;; Low-level
gmp-lib)
;; ===================================================================================================
;; 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)]))
(define (bigfloat-custom-write x port mode)
(write-string
(cond [(bfzero? x) (if (= 0 (bigfloat-signbit x)) "0.bf" "-0.bf")]
[(bfrational? x)
(define str (bigfloat->string x))
(cond [(regexp-match #rx"\\.|e" str)
(define exp (bigfloat-exponent x))
(define prec (bigfloat-precision x))
(if ((abs exp) . > . (* prec 2))
(format "(bf \"~a\")" str)
(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))
(cond
[(and mpfr-lib gmp-lib)
;; Only try to print if libmpfr was loaded; otherwise, we get an infinite loop when the
;; `make-not-available' handler tries to print any _mpfr arguments
(write-string
(cond [(bfzero? x) (if (= 0 (bigfloat-signbit x)) "0.bf" "-0.bf")]
[(bfrational? x)
(define str (bigfloat->string x))
(cond [(regexp-match #rx"\\.|e" str)
(define exp (bigfloat-exponent x))
(define prec (bigfloat-precision x))
(if ((abs exp) . > . (* prec 2))
(format "(bf \"~a\")" str)
(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