suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

disable single-flonum reading by default

Browse Source 
Add `single-flonum-available?` and `read-single-flonum`, where the
latter controls whether numbers that have an "s" or "f" exponent
marker are parsed as single-flonums are normal flonums. The parameter
is disabled by default, which changes the meaning of most existing
code that has a literal number with "s" or "f", including `+inf.f`,
`inf.f`, and `+nan.f`.

The compiler constant-folds `single-flonum-available?` and
`real->single-flonum` on a literal number, so use a combination of
those to replace most uses of a single-flonum literal. Single-flonums
within quoted data are less convenient.
This commit is contained in:
Matthew Flatt 2019-06-02 07:26:08 -07:00
parent 04e89b9445
commit fcdd8a91dc
32 changed files with 741 additions and 448 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "7.3.0.4") (define version "7.3.0.5")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

2
pkgs/racket-doc/scribblings/reference/extflonums.scrbl
View File

@ -7,7 +7,7 @@
@defmodule[racket/extflonum] @defmodule[racket/extflonum]
An @deftech{extflonum} is an extended-precision (80-bit) An @deftech{extflonum} is an extended-precision (80-bit)
floating-point number. extflonum arithmetic is supported on floating-point number. Extflonum arithmetic is supported on
platforms with extended-precision hardware and where the platforms with extended-precision hardware and where the
extflonum implementation does not conflict with normal extflonum implementation does not conflict with normal
double-precision arithmetic (i.e., on x86 and x86_64 platforms when double-precision arithmetic (i.e., on x86 and x86_64 platforms when

105
pkgs/racket-doc/scribblings/reference/numbers.scrbl
View File

@ -19,11 +19,15 @@
All @deftech{numbers} are @deftech{complex numbers}. Some of them are All @deftech{numbers} are @deftech{complex numbers}. Some of them are
@deftech{real numbers}, and all of the real numbers that can be @deftech{real numbers}, and all of the real numbers that can be
represented are also @deftech{rational numbers}, except for represented are also @deftech{rational numbers}, except for
@as-index{@racket[+inf.0]} (positive @as-index{infinity}), @as-index{@racket[+inf.f]} (single-precision variant), @as-index{@racket[+inf.0]} (positive @as-index{infinity}),
@as-index{@racket[-inf.0]} (negative infinity), @as-index{@racket[-inf.f]} (single-precision variant), @as-index{@racketvalfont{+inf.f}} (single-precision variant, when
@as-index{@racket[+nan.0]} (@as-index{not-a-number}), and @as-index{@racket[+nan.f]} (single-precision variant). Among the enabled via @racket[read-single-flonum]),
rational numbers, some are @deftech{integers}, because @racket[round] @as-index{@racket[-inf.0]} (negative infinity),
applied to the number produces the same number. @as-index{@racketvalfont{-inf.f}} (single-precision variant, when
enabled), @as-index{@racket[+nan.0]} (@as-index{not-a-number}), and
@as-index{@racketvalfont{+nan.f}} (single-precision variant, when
enabled). Among the rational numbers, some are @deftech{integers},
because @racket[round] applied to the number produces the same number.
@margin-note/ref{See @secref["parse-number"] for information on the @margin-note/ref{See @secref["parse-number"] for information on the
syntax of number literals.} syntax of number literals.}
@ -42,34 +46,40 @@ are both exact or inexact with the same precision, or the number has
an exact zero real part and an inexact imaginary part; a complex an exact zero real part and an inexact imaginary part; a complex
number with an exact zero imaginary part is a real number. number with an exact zero imaginary part is a real number.
Inexact real numbers are implemented as either single- or Inexact real numbers are implemented as double-precision
double-precision @as-index{IEEE floating-point numbers}---the latter @as-index{IEEE floating-point numbers}, also known as
by default, and the former only when a computation starts with @deftech{flonums}, or as single-precision IEEE floating-point numbers,
numerical constants specified as single-precision numbers. Inexact also known as @deftech{single-flonums}. Single-flonums are
real numbers that are represented as double-precision floating-point supported only when @racket[(single-flonum-available?)] reports
numbers are @deftech{flonums}. @racket[#t]. Although we write @racketvalfont{+inf.f},
@racketvalfont{-inf.f}, and @racketvalfont{+nan.f} to mean
single-flonums, those forms read as double-precision flonums by
default, since @racket[read-single-flonum] is @racket[#f] by default.
When single-flonums are supported, inexact numbers are still
represented as flonums by default, and single precision is used only
when a computation starts with single-flonums.
Inexact numbers can be coerced to exact form, except for the inexact Inexact numbers can be coerced to exact form, except for the inexact
numbers @racket[+inf.0], @racket[+inf.f], numbers @racket[+inf.0], @racketvalfont{+inf.f},
@racket[-inf.0], @racket[-inf.f], @racket[+nan.0], and @racket[+nan.f], which @racket[-inf.0], @racketvalfont{-inf.f}, @racket[+nan.0], and @racketvalfont{+nan.f}, which
have no exact form. @index["division by inexact zero"]{Dividing} a have no exact form. @index["division by inexact zero"]{Dividing} a
number by exact zero raises an exception; dividing a non-zero number number by exact zero raises an exception; dividing a non-zero number
other than @racket[+nan.0] or @racket[+nan.f] by an inexact zero returns @racket[+inf.0], other than @racket[+nan.0] or @racketvalfont{+nan.f} by an inexact zero returns @racket[+inf.0],
@racket[+inf.f], @racket[-inf.0] @racketvalfont{+inf.f}, @racket[-inf.0]
or @racket[-inf.f], depending on the sign and precision of the dividend. The or @racketvalfont{-inf.f}, depending on the sign and precision of the dividend. The
@racket[+nan.0] value is not @racket[=] to itself, but @racket[+nan.0] @racket[+nan.0] value is not @racket[=] to itself, but @racket[+nan.0]
is @racket[eqv?] to itself, and @racket[+nan.f] is similarly @racket[eqv?] but is @racket[eqv?] to itself, and @racketvalfont{+nan.f} is similarly @racket[eqv?] but
not @racket[=] to itself. Conversely, @racket[(= 0.0 -0.0)] is not @racket[=] to itself. Conversely, @racket[(= 0.0 -0.0)] is
@racket[#t], but @racket[(eqv? 0.0 -0.0)] is @racket[#f], and the @racket[#t], but @racket[(eqv? 0.0 -0.0)] is @racket[#f], and the
same for @racket[0.0f0] and @racket[-0.0f0] (which are single-precision variants). The datum same for @racket[0.0f0] and @racket[-0.0f0] (which are single-precision variants). The datum
@racketvalfont{-nan.0} refers to the same constant as @racket[+nan.0], @racketvalfont{-nan.0} refers to the same constant as @racket[+nan.0],
and @racketvalfont{-nan.f} is the same as @racket[+nan.f]. and @racketvalfont{-nan.f} is the same as @racketvalfont{+nan.f}.
Calculations with infinites produce results consistent with IEEE Calculations with infinites produce results consistent with IEEE
double- or single-precision floating point where IEEE specifies the result; in double- or single-precision floating point where IEEE specifies the result; in
cases where IEEE provides no specification, cases where IEEE provides no specification,
the result corresponds to the limit approaching the result corresponds to the limit approaching
infinity, or @racket[+nan.0] or @racket[+nan.f] if no such limit exists. infinity, or @racket[+nan.0] or @racketvalfont{+nan.f} if no such limit exists.
The precision and size of exact numbers is limited only by available The precision and size of exact numbers is limited only by available
memory (and the precision of operations that can produce irrational memory (and the precision of operations that can produce irrational
@ -88,7 +98,7 @@ by the default reader in @racket[read-syntax] mode are @tech{interned} and there
when they are @racket[eqv?]. when they are @racket[eqv?].
Two real numbers are @racket[eqv?] when they are both inexact with the same precision or both Two real numbers are @racket[eqv?] when they are both inexact with the same precision or both
exact, and when they are @racket[=] (except for @racket[+nan.0], @racket[+nan.f], exact, and when they are @racket[=] (except for @racket[+nan.0], @racketvalfont{+nan.f},
@racket[+0.0], @racket[+0.0f0], @racket[-0.0], and @racket[-0.0f0], as noted above). @racket[+0.0], @racket[+0.0f0], @racket[-0.0], and @racket[-0.0f0], as noted above).
Two complex numbers are @racket[eqv?] when their real and imaginary parts are @racket[eqv?]. Two complex numbers are @racket[eqv?] when their real and imaginary parts are @racket[eqv?].
Two numbers are @racket[equal?] when they are @racket[eqv?]. Two numbers are @racket[equal?] when they are @racket[eqv?].
@ -173,9 +183,25 @@ otherwise.}
@defproc[(double-flonum? [v any/c]) boolean?]{ @defproc[(double-flonum? [v any/c]) boolean?]{
Identical to @racket[flonum?]}. Identical to @racket[flonum?]}.
@defproc[(single-flonum? [v any/c]) boolean?]{ @defproc[(single-flonum? [v any/c]) boolean?]{ Return @racket[#t] if
Return @racket[#t] if @racket[v] is a single-precision floating-point @racket[v] is a @tech{single-flonum} (i.e., a single-precision
number, @racket[#f] otherwise.} floating-point number), @racket[#f] otherwise.}
@defproc[(single-flonum-available?) boolean?]{
Returns @racket[#t] if @tech{single-flonums} are supported on
the current platform, @racket[#f] otherwise.
Currently, @racket[single-flonum-available?] produces @racket[#t] when
@racket[(system-type 'vm)] produces @racket['racket], and
@racket[single-flonum-available?] produces @racket[#f] otherwise.
If the result is @racket[#f], then @racket[single-flonum?] also
produces @racket[#f] for all arguments.
@history[#:added "7.3.0.5"]}
@defproc[(zero? [z number?]) boolean?]{ Returns @racket[(= 0 z)]. @defproc[(zero? [z number?]) boolean?]{ Returns @racket[(= 0 z)].
@ -218,7 +244,7 @@ number, @racket[#f] otherwise.}
@defproc[(inexact->exact [z number?]) exact?]{ Coerces @racket[z] to an @defproc[(inexact->exact [z number?]) exact?]{ Coerces @racket[z] to an
exact number. If @racket[z] is already exact, it is returned. If @racket[z] exact number. If @racket[z] is already exact, it is returned. If @racket[z]
is @racket[+inf.0], @racket[-inf.0], @racket[+nan.0], is @racket[+inf.0], @racket[-inf.0], @racket[+nan.0],
@racket[+inf.f], @racket[-inf.f], or @racket[+nan.f], then the @racketvalfont{+inf.f}, @racketvalfont{-inf.f}, or @racketvalfont{+nan.f}, then the
@exnraise[exn:fail:contract]. @exnraise[exn:fail:contract].
@mz-examples[(inexact->exact 1) (inexact->exact 1.0)]} @mz-examples[(inexact->exact 1) (inexact->exact 1.0)]}
@ -1064,7 +1090,11 @@ evaluates the entire sequence.
[decimal-mode (or/c 'decimal-as-inexact 'decimal-as-exact) [decimal-mode (or/c 'decimal-as-inexact 'decimal-as-exact)
(if (read-decimal-as-inexact) (if (read-decimal-as-inexact)
'decimal-as-inexact 'decimal-as-inexact
'decimal-as-exact)]) 'decimal-as-exact)]
[single-mode (or/c 'single 'double)
(if (read-single-flonum)
'single
'double)])
(or/c number? #f string? extflonum?)]{ (or/c number? #f string? extflonum?)]{
Reads and returns a number datum from @racket[s] (see Reads and returns a number datum from @racket[s] (see
@ -1085,6 +1115,9 @@ The @racket[decimal-mode] argument controls number parsing the same
way that the @racket[read-decimal-as-inexact] parameter affects way that the @racket[read-decimal-as-inexact] parameter affects
@racket[read]. @racket[read].
The @racket[single-mode] argument controls number parsing the same way
that the @racket[read-single-flonum] parameter affects @racket[read].
@mz-examples[(string->number "3.0+2.5i") @mz-examples[(string->number "3.0+2.5i")
(string->number "hello") (string->number "hello")
(string->number "111" 7) (string->number "111" 7)
@ -1093,7 +1126,8 @@ way that the @racket[read-decimal-as-inexact] parameter affects
(string->number "10.3" 10 'read 'decimal-as-exact)] (string->number "10.3" 10 'read 'decimal-as-exact)]
@history[#:changed "6.8.0.2" @elem{Added the @racket[convert-mode] and @history[#:changed "6.8.0.2" @elem{Added the @racket[convert-mode] and
@racket[decimal-mode] arguments.}]} @racket[decimal-mode] arguments.}
#:changed "7.3.0.5" @elem{Added the @racket[single-mode] argument.}]}
@defproc[(real->decimal-string [n real?] [decimal-digits exact-nonnegative-integer? 2]) @defproc[(real->decimal-string [n real?] [decimal-digits exact-nonnegative-integer? 2])
@ -1227,15 +1261,12 @@ pi
(cos pi) (cos pi)
]} ]}
@defthing[pi.f single-flonum?]{ @defthing[pi.f (or/c single-flonum? flonum?)]{
Like @racket[pi], but in single precision. The same value as @racket[pi], but as a single-precision
@examples[ floating-point number if the current platform supports it.
#:eval math-eval
pi.f @history[#:changed "7.3.0.5" @elem{Allow value to be a double-precision flonum.}]}
(* 2.0f0 pi)
(* 2.0f0 pi.f)
]}
@defproc[(degrees->radians [x real?]) real?]{ @defproc[(degrees->radians [x real?]) real?]{
@ -1259,7 +1290,7 @@ Converts @racket[x] radians to degrees.
Returns @racket[(* z z)].} Returns @racket[(* z z)].}
@defproc[(sgn [x real?]) (or/c (=/c -1) (=/c 0) (=/c 1) +nan.0 +nan.f)]{ @defproc[(sgn [x real?]) (or/c (=/c -1) (=/c 0) (=/c 1) +nan.0 @#,racketvalfont{+nan.f})]{
Returns the sign of @racket[x] as either @math{-1}, @math{0}, Returns the sign of @racket[x] as either @math{-1}, @math{0},
@math{1}, or not-a-number. @math{1}, or not-a-number.
@ -1331,11 +1362,11 @@ Hence also:
@defproc[(nan? [x real?]) boolean?]{ @defproc[(nan? [x real?]) boolean?]{
Returns @racket[#t] if @racket[x] is @racket[eqv?] to @racket[+nan.0] or @racket[+nan.f]; otherwise @racket[#f].} Returns @racket[#t] if @racket[x] is @racket[eqv?] to @racket[+nan.0] or @racketvalfont{+nan.f}; otherwise @racket[#f].}
@defproc[(infinite? [x real?]) boolean?]{ @defproc[(infinite? [x real?]) boolean?]{
Returns @racket[#t] if @racket[x] is @racket[+inf.0], @racket[-inf.0], @racket[+inf.f], @racket[-inf.f]; otherwise @racket[#f].} Returns @racket[#t] if @racket[x] is @racket[+inf.0], @racket[-inf.0], @racketvalfont{+inf.f}, @racketvalfont{-inf.f}; otherwise @racket[#f].}
@defproc[(positive-integer? [x any/c]) boolean?]{ @defproc[(positive-integer? [x any/c]) boolean?]{
Like @racket[exact-positive-integer?], but also returns Like @racket[exact-positive-integer?], but also returns

8
pkgs/racket-doc/scribblings/reference/read.scrbl
View File

@ -260,6 +260,14 @@ A @tech{parameter} that controls parsing input numbers with a decimal point
or exponent (but no explicit exactness tag). See or exponent (but no explicit exactness tag). See
@secref["parse-number"] for more information.} @secref["parse-number"] for more information.}
@defboolparam[read-single-flonum on?]{
A @tech{parameter} that controls parsing input numbers that have a
@litchar{f}, @litchar{S}, @litchar{s}, or @litchar{S} precision
character. See @secref["parse-number"] for more information.
@history[#:added "7.3.0.5"]}
@defboolparam[read-accept-dot on?]{ @defboolparam[read-accept-dot on?]{
A @tech{parameter} that controls parsing input with a dot, which is normally A @tech{parameter} that controls parsing input with a dot, which is normally

21
pkgs/racket-doc/scribblings/reference/reader.scrbl
View File

@ -266,14 +266,19 @@ reverse order: @litchar{#b}, @litchar{#o}, @litchar{#d}, or
@litchar{#x} followed by @litchar{#e} or @litchar{#i}. @litchar{#x} followed by @litchar{#e} or @litchar{#i}.
An @nunterm{exponent-mark} in an inexact number serves both to specify An @nunterm{exponent-mark} in an inexact number serves both to specify
an exponent and to specify a numerical precision. If single-precision an exponent and to specify a numerical precision. If
IEEE floating point is supported (see @secref["numbers"]), the marks @tech{single-flonums} are supported (see @secref["numbers"]) and the
@litchar{f} and @litchar{s} specify single-precision. Otherwise, or @racket[read-single-flonum] @tech{parameter} is set to @racket[#t],
with any other mark, double-precision IEEE floating point is used. the marks @litchar{f} and @litchar{s} specify single-flonums. If
In addition, single- and double-precision specials are distinct; @racket[read-single-flonum] is set to @racket[#f], or with any other
specials with the @litchar{.0} suffix, like @racket[-nan.0] are mark, a double-precision @tech{flonum} is produced. If single-flonums
double-precision, whereas specials with the @litchar{.f} suffix are are not supported and @racket[read-single-flonum] is set to
single-precision. @racket[#t], then the @exnraise[exn:fail:unsupported] when a single-flonum
would otherwise be produced. Special infinity and not-a-number flonums
and single-flonums are distinct; specials with the @litchar{.0}
suffix, like @racket[+nan.0], are double-precision flonums, while
specials with the @litchar{.f} suffix, like @racketvalfont{+nan.0},
are single-flonums if enabled though @racket[read-single-flonum].
A @litchar{#} in an @nunterm{inexact} number is the same as A @litchar{#} in an @nunterm{inexact} number is the same as
@litchar{0}, but @litchar{#} can be used to suggest @litchar{0}, but @litchar{#} can be used to suggest

159
pkgs/racket-test-core/tests/racket/math.rktl
View File

@ -57,7 +57,7 @@
(define (single=? x y) (define (single=? x y)
(cond (cond
[(eq? 'chez-scheme (system-type 'vm)) [(not (single-flonum-available?))
(double=? x y)] (double=? x y)]
[else [else
(and (single-flonum? y) (and (single-flonum? y)
@ -70,7 +70,8 @@
(test #t single=? #e3.141592653589793238462643383279502884197169399 pi.f) (test #t single=? #e3.141592653589793238462643383279502884197169399 pi.f)
(test #t double=? #e3.141592653589793238462643383279502884197169399 pi) (test #t double=? #e3.141592653589793238462643383279502884197169399 pi)
(test pi.f real->single-flonum pi) (when (single-flonum-available?)
(test pi.f real->single-flonum pi))
;; ========================================================================= ;; =========================================================================
;; nan? ;; nan?
@ -265,12 +266,14 @@
(test 0 sinh 0) (test 0 sinh 0)
(test #t double=? sinh+1 (sinh 1)) (test #t double=? sinh+1 (sinh 1))
(test +nan.f sinh +nan.f) #reader "maybe-single.rkt"
(test -inf.f sinh -inf.f) (begin
(test #t single=? sinh-1 (sinh -1.0f0)) (test +nan.f sinh +nan.f)
(test 0.0f0 sinh 0.0f0) (test -inf.f sinh -inf.f)
(test #t single=? sinh+1 (sinh 1.0f0)) (test #t single=? sinh-1 (sinh -1.0f0))
(test +inf.f sinh +inf.f) (test 0.0f0 sinh 0.0f0)
(test #t single=? sinh+1 (sinh 1.0f0))
(test +inf.f sinh +inf.f))
(test +nan.0 sinh +nan.0) (test +nan.0 sinh +nan.0)
(test -inf.0 sinh -inf.0) (test -inf.0 sinh -inf.0)
@ -293,13 +296,15 @@
(test 1.0 cosh 0) (test 1.0 cosh 0)
(test #t double=? cosh+1 (cosh 1)) (test #t double=? cosh+1 (cosh 1))
(test +nan.f cosh +nan.f) #reader "maybe-single.rkt"
(test +inf.f cosh -inf.f) (begin
(test #t single=? cosh+1 (cosh -1.0f0)) (test +nan.f cosh +nan.f)
(test 1.0f0 cosh -0.0f0) (test +inf.f cosh -inf.f)
(test 1.0f0 cosh 0.0f0) (test #t single=? cosh+1 (cosh -1.0f0))
(test #t single=? cosh+1 (cosh 1.0f0)) (test 1.0f0 cosh -0.0f0)
(test +inf.f cosh +inf.f) (test 1.0f0 cosh 0.0f0)
(test #t single=? cosh+1 (cosh 1.0f0))
(test +inf.f cosh +inf.f))
(test +nan.0 cosh +nan.0) (test +nan.0 cosh +nan.0)
(test +inf.0 cosh -inf.0) (test +inf.0 cosh -inf.0)
@ -325,15 +330,17 @@
(test #t double=? tanh+1 (tanh 1)) (test #t double=? tanh+1 (tanh 1))
(test 1.0 tanh 20) (test 1.0 tanh 20)
(test +nan.f tanh +nan.f) #reader "maybe-single.rkt"
(test -1.0f0 tanh -inf.f) (begin
(test -1.0f0 tanh -20.0f0) (test +nan.f tanh +nan.f)
(test #t single=? tanh-1 (tanh -1.0f0)) (test -1.0f0 tanh -inf.f)
(test -0.0f0 tanh -0.0f0) (test -1.0f0 tanh -20.0f0)
(test 0.0f0 tanh 0.0f0) (test #t single=? tanh-1 (tanh -1.0f0))
(test #t single=? tanh+1 (tanh 1.0f0)) (test -0.0f0 tanh -0.0f0)
(test 1.0f0 tanh 20.0f0) (test 0.0f0 tanh 0.0f0)
(test 1.0f0 tanh +inf.f) (test #t single=? tanh+1 (tanh 1.0f0))
(test 1.0f0 tanh 20.0f0)
(test 1.0f0 tanh +inf.f))
(test +nan.0 tanh +nan.0) (test +nan.0 tanh +nan.0)
(test -1.0 tanh -inf.0) (test -1.0 tanh -inf.0)
@ -358,15 +365,17 @@
(test #t double=? (* 1/2 pi) (degrees->radians 90)) (test #t double=? (* 1/2 pi) (degrees->radians 90))
(test #t double=? pi (degrees->radians 180)) (test #t double=? pi (degrees->radians 180))
(test +nan.f degrees->radians +nan.f) #reader "maybe-single.rkt"
(test -inf.f degrees->radians -inf.f) (begin
(test #t single=? (- pi) (degrees->radians -180.0f0)) (test +nan.f degrees->radians +nan.f)
(test #t single=? (* -1/2 pi) (degrees->radians -90.0f0)) (test -inf.f degrees->radians -inf.f)
(test -0.0f0 degrees->radians -0.0f0) (test #t single=? (- pi) (degrees->radians -180.0f0))
(test 0.0f0 degrees->radians 0.0f0) (test #t single=? (* -1/2 pi) (degrees->radians -90.0f0))
(test #t single=? (* 1/2 pi) (degrees->radians 90.0f0)) (test -0.0f0 degrees->radians -0.0f0)
(test #t single=? pi (degrees->radians 180.0f0)) (test 0.0f0 degrees->radians 0.0f0)
(test +inf.f degrees->radians +inf.f) (test #t single=? (* 1/2 pi) (degrees->radians 90.0f0))
(test #t single=? pi (degrees->radians 180.0f0))
(test +inf.f degrees->radians +inf.f))
(test +nan.0 degrees->radians +nan.0) (test +nan.0 degrees->radians +nan.0)
(test -inf.0 degrees->radians -inf.0) (test -inf.0 degrees->radians -inf.0)
@ -385,15 +394,17 @@
(test 0 radians->degrees 0) (test 0 radians->degrees 0)
(test +nan.f radians->degrees +nan.f) #reader "maybe-single.rkt"
(test -inf.f radians->degrees -inf.f) (begin
(test #t single=? -180 (radians->degrees (- pi.f))) (test +nan.f radians->degrees +nan.f)
(test #t single=? -90 (radians->degrees (* -1/2 pi.f))) (test -inf.f radians->degrees -inf.f)
(test -0.0f0 radians->degrees -0.0f0) (test #t single=? -180 (radians->degrees (- pi.f)))
(test 0.0f0 radians->degrees 0.0f0) (test #t single=? -90 (radians->degrees (* -1/2 pi.f)))
(test #t single=? 90 (radians->degrees (* 1/2 pi.f))) (test -0.0f0 radians->degrees -0.0f0)
(test #t single=? 180 (radians->degrees pi.f)) (test 0.0f0 radians->degrees 0.0f0)
(test +inf.f radians->degrees +inf.f) (test #t single=? 90 (radians->degrees (* 1/2 pi.f)))
(test #t single=? 180 (radians->degrees pi.f))
(test +inf.f radians->degrees +inf.f))
(test +nan.0 radians->degrees +nan.0) (test +nan.0 radians->degrees +nan.0)
(test -inf.0 radians->degrees -inf.0) (test -inf.0 radians->degrees -inf.0)
@ -415,13 +426,15 @@
(test 0 exact-round #e0.5) (test 0 exact-round #e0.5)
(test 2 exact-round #e1.5) (test 2 exact-round #e1.5)
(err/rt-test (exact-round +nan.f)) #reader "maybe-single.rkt"
(err/rt-test (exact-round -inf.f)) (begin
(test -2 exact-round -1.5f0) (err/rt-test (exact-round +nan.f))
(test 0 exact-round -0.5f0) (err/rt-test (exact-round -inf.f))
(test 0 exact-round 0.5f0) (test -2 exact-round -1.5f0)
(test 2 exact-round 1.5f0) (test 0 exact-round -0.5f0)
(err/rt-test (exact-round +inf.f)) (test 0 exact-round 0.5f0)
(test 2 exact-round 1.5f0)
(err/rt-test (exact-round +inf.f)))
(err/rt-test (exact-round +nan.0)) (err/rt-test (exact-round +nan.0))
(err/rt-test (exact-round -inf.0)) (err/rt-test (exact-round -inf.0))
@ -443,13 +456,15 @@
(test 0 exact-floor #e0.5) (test 0 exact-floor #e0.5)
(test 1 exact-floor #e1.5) (test 1 exact-floor #e1.5)
(err/rt-test (exact-floor +nan.f)) #reader "maybe-single.rkt"
(err/rt-test (exact-floor -inf.f)) (begin
(test -2 exact-floor -1.5f0) (err/rt-test (exact-floor +nan.f))
(test -1 exact-floor -0.5f0) (err/rt-test (exact-floor -inf.f))
(test 0 exact-floor 0.5f0) (test -2 exact-floor -1.5f0)
(test 1 exact-floor 1.5f0) (test -1 exact-floor -0.5f0)
(err/rt-test (exact-floor +inf.f)) (test 0 exact-floor 0.5f0)
(test 1 exact-floor 1.5f0)
(err/rt-test (exact-floor +inf.f)))
(err/rt-test (exact-floor +nan.0)) (err/rt-test (exact-floor +nan.0))
(err/rt-test (exact-floor -inf.0)) (err/rt-test (exact-floor -inf.0))
@ -471,13 +486,15 @@
(test 1 exact-ceiling #e0.5) (test 1 exact-ceiling #e0.5)
(test 2 exact-ceiling #e1.5) (test 2 exact-ceiling #e1.5)
(err/rt-test (exact-ceiling +nan.f)) #reader "maybe-single.rkt"
(err/rt-test (exact-ceiling -inf.f)) (begin
(test -1 exact-ceiling -1.5f0) (err/rt-test (exact-ceiling +nan.f))
(test 0 exact-ceiling -0.5f0) (err/rt-test (exact-ceiling -inf.f))
(test 1 exact-ceiling 0.5f0) (test -1 exact-ceiling -1.5f0)
(test 2 exact-ceiling 1.5f0) (test 0 exact-ceiling -0.5f0)
(err/rt-test (exact-ceiling +inf.f)) (test 1 exact-ceiling 0.5f0)
(test 2 exact-ceiling 1.5f0)
(err/rt-test (exact-ceiling +inf.f)))
(err/rt-test (exact-ceiling +nan.0)) (err/rt-test (exact-ceiling +nan.0))
(err/rt-test (exact-ceiling -inf.0)) (err/rt-test (exact-ceiling -inf.0))
@ -499,13 +516,15 @@
(test 0 exact-truncate #e0.5) (test 0 exact-truncate #e0.5)
(test 1 exact-truncate #e1.5) (test 1 exact-truncate #e1.5)
(err/rt-test (exact-truncate +nan.f)) #reader "maybe-single.rkt"
(err/rt-test (exact-truncate -inf.f)) (begin
(test -1 exact-truncate -1.5f0) (err/rt-test (exact-truncate +nan.f))
(test 0 exact-truncate -0.5f0) (err/rt-test (exact-truncate -inf.f))
(test 0 exact-truncate 0.5f0) (test -1 exact-truncate -1.5f0)
(test 1 exact-truncate 1.5f0) (test 0 exact-truncate -0.5f0)
(err/rt-test (exact-truncate +inf.f)) (test 0 exact-truncate 0.5f0)
(test 1 exact-truncate 1.5f0)
(err/rt-test (exact-truncate +inf.f)))
(err/rt-test (exact-truncate +nan.0)) (err/rt-test (exact-truncate +nan.0))
(err/rt-test (exact-truncate -inf.0)) (err/rt-test (exact-truncate -inf.0))

13
pkgs/racket-test-core/tests/racket/maybe-single.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang racket/base
(provide (rename-out
[sf:read read]
[sf:read-syntax read-syntax]))
(define (sf:read in mod line col pos)
(parameterize ([read-single-flonum (single-flonum-available?)])
(read in)))
(define (sf:read-syntax in src mod line col pos)
(parameterize ([read-single-flonum (single-flonum-available?)])
(read-syntax in src)))

104
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -5,7 +5,7 @@
(require racket/extflonum racket/random racket/list) (require racket/extflonum racket/random racket/list)
(define has-single-flonum? (not (eq? 'chez-scheme (system-type 'vm)))) (define has-single-flonum? (single-flonum-available?))
(define has-exact-zero-inexact-complex? (not (eq? 'chez-scheme (system-type 'vm)))) (define has-exact-zero-inexact-complex? (not (eq? 'chez-scheme (system-type 'vm))))
(test #f number? 'a) (test #f number? 'a)
@ -82,8 +82,10 @@
(test #f single-flonum? 1.2) (test #f single-flonum? 1.2)
(test #t flonum? 1.2e3) (test #t flonum? 1.2e3)
(test #f single-flonum? 1.2e3) (test #f single-flonum? 1.2e3)
(test (not has-single-flonum?) flonum? 1.2f3) #reader "maybe-single.rkt"
(test has-single-flonum? single-flonum? 1.2f3) (begin
(test (not has-single-flonum?) flonum? 1.2f3)
(test has-single-flonum? single-flonum? 1.2f3))
(test #t complex? -4.242154731064108e-5-6.865001427422244e-5i) (test #t complex? -4.242154731064108e-5-6.865001427422244e-5i)
(test #f exact? -4.242154731064108e-5-6.865001427422244e-5i) (test #f exact? -4.242154731064108e-5-6.865001427422244e-5i)
@ -122,32 +124,40 @@
(test #t real? +inf.f) (test #t real? +inf.f)
(test #f rational? +inf.f) (test #f rational? +inf.f)
(test #f integer? +inf.f) (test #f integer? +inf.f)
(test (not has-single-flonum?) flonum? +inf.f) #reader "maybe-single.rkt"
(test has-single-flonum? single-flonum? +inf.f) (begin
(test (not has-single-flonum?) flonum? +inf.f)
(test has-single-flonum? single-flonum? +inf.f))
(test #t number? -inf.f) (test #t number? -inf.f)
(test #t complex? -inf.f) (test #t complex? -inf.f)
(test #t real? -inf.f) (test #t real? -inf.f)
(test #f rational? -inf.f) (test #f rational? -inf.f)
(test #f integer? -inf.f) (test #f integer? -inf.f)
(test (not has-single-flonum?) flonum? -inf.f) #reader "maybe-single.rkt"
(test has-single-flonum? single-flonum? -inf.f) (begin
(test (not has-single-flonum?) flonum? -inf.f)
(test has-single-flonum? single-flonum? -inf.f))
(test #t number? +nan.f) (test #t number? +nan.f)
(test #t complex? +nan.f) (test #t complex? +nan.f)
(test #t real? +nan.f) (test #t real? +nan.f)
(test #f rational? +nan.f) (test #f rational? +nan.f)
(test #f integer? +nan.f) (test #f integer? +nan.f)
(test (not has-single-flonum?) flonum? +nan.f) #reader "maybe-single.rkt"
(test has-single-flonum? single-flonum? +nan.f) (begin
(test (not has-single-flonum?) flonum? +nan.f)
(test has-single-flonum? single-flonum? +nan.f))
(test #t number? -nan.f) (test #t number? -nan.f)
(test #t complex? -nan.f) (test #t complex? -nan.f)
(test #t real? -nan.f) (test #t real? -nan.f)
(test #f rational? -nan.f) (test #f rational? -nan.f)
(test #f integer? -nan.f) (test #f integer? -nan.f)
(test (not has-single-flonum?) flonum? -nan.f) #reader "maybe-single.rkt"
(test has-single-flonum? single-flonum? -nan.f) (begin
(test (not has-single-flonum?) flonum? -nan.f)
(test has-single-flonum? single-flonum? -nan.f))
(arity-test inexact? 1 1) (arity-test inexact? 1 1)
(arity-test number? 1 1) (arity-test number? 1 1)
@ -166,16 +176,18 @@
(test "+nan.0" number->string +nan.0) (test "+nan.0" number->string +nan.0)
(test "+nan.0" number->string +nan.0) (test "+nan.0" number->string +nan.0)
(test (if has-single-flonum? "+inf.f" "+inf.0") number->string +inf.f) #reader "maybe-single.rkt"
(test (if has-single-flonum? "-inf.f" "-inf.0") number->string -inf.f) (begin
(test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f) (test (if has-single-flonum? "+inf.f" "+inf.0") number->string +inf.f)
(test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f) (test (if has-single-flonum? "-inf.f" "-inf.0") number->string -inf.f)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f0) (test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f1) (test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f17) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f0)
(test (if has-single-flonum? "13.25f0" "13.25") number->string 13.25f0) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f1)
(test (if has-single-flonum? "13.25f0" "13.25") number->string 1.325f1) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f17)
(test (if has-single-flonum? "-4.25f0" "-4.25") number->string -4.25f0) (test (if has-single-flonum? "13.25f0" "13.25") number->string 13.25f0)
(test (if has-single-flonum? "13.25f0" "13.25") number->string 1.325f1)
(test (if has-single-flonum? "-4.25f0" "-4.25") number->string -4.25f0))
(map (lambda (n) (map (lambda (n)
;; test that fresh strings are generated: ;; test that fresh strings are generated:
@ -584,8 +596,10 @@
(test +inf.f expt -4.0f0 (expt 2 5000)) (test +inf.f expt -4.0f0 (expt 2 5000))
(test -inf.f expt -4.0f0 (add1 (expt 2 5000))) (test -inf.f expt -4.0f0 (add1 (expt 2 5000)))
;; exponent large enough to overflow singles, but not doubles ;; exponent large enough to overflow singles, but not doubles
(test +inf.f expt -4.0f0 (lcm (exact-round -1.7976931348623151e+308))) #reader "maybe-single.rkt"
(test -inf.f expt -4.0f0 (add1 (lcm (exact-round -1.7976931348623151e+308)))) (when has-single-flonum?
(test +inf.f expt -4.0f0 (lcm (exact-round -1.7976931348623151e+308)))
(test -inf.f expt -4.0f0 (add1 (lcm (exact-round -1.7976931348623151e+308)))))
(define (inf-non-real? x) (define (inf-non-real? x)
(and (not (real? x)) (and (not (real? x))
@ -726,27 +740,37 @@
(err/rt-test (inexact->exact -inf.0)) (err/rt-test (inexact->exact -inf.0))
(err/rt-test (inexact->exact +nan.0)) (err/rt-test (inexact->exact +nan.0))
#reader "maybe-single.rkt"
(when has-single-flonum? (when has-single-flonum?
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-message exn)))) (err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-message exn))))
(err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-message exn)))) (err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-message exn))))
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-message exn))))) (err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-message exn)))))
(test 2.0f0 real->single-flonum 2) #reader "maybe-single.rkt"
(test 2.25f0 real->single-flonum 2.25) (when has-single-flonum?
(test 2.25f0 real->single-flonum 2.25f0) (test 2.0f0 real->single-flonum 2)
(test 2.0 real->double-flonum 2) (test 2.25f0 real->single-flonum 2.25)
(test 2.25 real->double-flonum 2.25) (test 2.25f0 real->single-flonum 2.25f0)
(test 2.25 real->double-flonum 2.25f0) (test 2.0 real->double-flonum 2)
(test 2.25 real->double-flonum 2.25)
(test 2.25 real->double-flonum 2.25f0))
;; to make sure they work when jitted ;; to make sure they work when jitted
(define (r->s-f x) (real->single-flonum x)) (define (r->s-f x) (real->single-flonum x))
(define (r->d-f x) (real->double-flonum x)) (define (r->d-f x) (real->double-flonum x))
(test 2.0f0 r->s-f 2) #reader "maybe-single.rkt"
(test 2.25f0 r->s-f 2.25) (when has-single-flonum?
(test 2.25f0 r->s-f 2.25f0) (test 2.0f0 r->s-f 2)
(test 2.0 r->d-f 2) (test 2.25f0 r->s-f 2.25)
(test 2.25 r->d-f 2.25) (test 2.25f0 r->s-f 2.25f0)
(test 2.25 r->d-f 2.25f0) (test 2.0 r->d-f 2)
(test 2.25 r->d-f 2.25)
(test 2.25 r->d-f 2.25f0))
(unless has-single-flonum?
(err/rt-test (real->single-flonum 1.0) exn:fail:unsupported?)
(err/rt-test (real->single-flonum +inf.0) exn:fail:unsupported?)
(err/rt-test (real->single-flonum +nan.0) exn:fail:unsupported?))
(err/rt-test (* 'a 0)) (err/rt-test (* 'a 0))
(err/rt-test (+ 'a 0)) (err/rt-test (+ 'a 0))
@ -2137,7 +2161,8 @@
(list +inf.0 +inf.0 (* 1/4 +pi)) (list +inf.0 +inf.0 (* 1/4 +pi))
(list -inf.0 +inf.0 (* 1/4 -pi)))]) (list -inf.0 +inf.0 (* 1/4 -pi)))])
(test (caddr a) atan (car a) (cadr a)) (test (caddr a) atan (car a) (cadr a))
(test (real->single-flonum (caddr a)) atan (real->single-flonum (car a)) (real->single-flonum (cadr a))))) (when has-single-flonum?
(test (real->single-flonum (caddr a)) atan (real->single-flonum (car a)) (real->single-flonum (cadr a))))))
(test 1 exp 0) (test 1 exp 0)
(test 1.0 exp 0.0) (test 1.0 exp 0.0)
@ -2451,7 +2476,7 @@
(test #f inexact? (string->number "#e4@5")) (test #f inexact? (string->number "#e4@5"))
(test #f inexact? (string->number "#e4.0@5.0")) (test #f inexact? (string->number "#e4.0@5.0"))
(arity-test string->number 1 4) (arity-test string->number 1 5)
(arity-test number->string 1 2) (arity-test number->string 1 2)
(err/rt-test (number->string 'a)) (err/rt-test (number->string 'a))
@ -2975,6 +3000,7 @@
(test (expt 2 256) inexact->exact 1.157920892373162d+77) (test (expt 2 256) inexact->exact 1.157920892373162d+77)
(test 115792089237316195423570985008687907853269984665640564039457584007913129639936 inexact->exact 1.157920892373162d+77) (test 115792089237316195423570985008687907853269984665640564039457584007913129639936 inexact->exact 1.157920892373162d+77)
#reader "maybe-single.rkt"
(when has-single-flonum? (when has-single-flonum?
(test 521335/89202980794122492566142873090593446023921664 inexact->exact 5.844367f-39) (test 521335/89202980794122492566142873090593446023921664 inexact->exact 5.844367f-39)
(test 5.844367f-39 real->single-flonum (inexact->exact 5.844367f-39)) (test 5.844367f-39 real->single-flonum (inexact->exact 5.844367f-39))
@ -3250,6 +3276,7 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check single-flonum coercisons: ;; Check single-flonum coercisons:
#reader "maybe-single.rkt"
(define ((check-single-flonum #:real-only? [real-only? #f] (define ((check-single-flonum #:real-only? [real-only? #f]
#:integer-only? [integer-only? #f] #:integer-only? [integer-only? #f]
#:two-arg-real-only? [two-arg-real-only? real-only?] #:two-arg-real-only? [two-arg-real-only? real-only?]
@ -3457,7 +3484,8 @@
(check #e100000000000000.0 #e100000000000000.1 exact->inexact inexact->exact >=) (check #e100000000000000.0 #e100000000000000.1 exact->inexact inexact->exact >=)
(check #e100000000000000.0 #e100000000000000.1 real->double-flonum inexact->exact >=) (check #e100000000000000.0 #e100000000000000.1 real->double-flonum inexact->exact >=)
(check #e1000000.0 #e1000000.1 real->single-flonum inexact->exact >=) (when has-single-flonum?
(check #e1000000.0 #e1000000.1 real->single-flonum inexact->exact >=))
(when (extflonum-available?) (when (extflonum-available?)
(check #e1000000000000000000.0 #e1000000000000000000.1 real->extfl extfl->exact extfl>=)) (check #e1000000000000000000.0 #e1000000000000000000.1 real->extfl extfl->exact extfl>=))

78
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -263,31 +263,61 @@
(err/rt-test (readstr "#\"\u0100\"") exn:fail:read?) (err/rt-test (readstr "#\"\u0100\"") exn:fail:read?)
(err/rt-test (readstr "#\"\u03BB\"") exn:fail:read?) (err/rt-test (readstr "#\"\u03BB\"") exn:fail:read?)
(define (check-all-numbers number-table)
(let loop ([l number-table])
(unless (null? l)
(let* ([pair (car l)]
[v (car pair)]
[s (cadr pair)])
(for ([s (in-list (list s (string-upcase s)))])
(cond
[(memq v '(X DBZ NOE))
(err/rt-test (readstr s) exn:fail:read?)
(test #f string->number s)
(test #t string? (string->number s 10 'read))]
[v
(test v readstr s)
(test (if (symbol? v) #f v) string->number s)
(test (if (symbol? v) #f v) string->number s 10 'read)]
[else
(test (string->symbol s) readstr s)
(test #f string->number s)
(test #f string->number s 10 'read)
(unless (regexp-match "#" s)
(err/rt-test (readstr (string-append "#d" s)) exn:fail:read?)
(test #f string->number (string-append "#d" s))
(test #t string? (string->number (string-append "#d" s) 10 'read)))])))
(loop (cdr l)))))
(load-relative "numstrs.rktl") (load-relative "numstrs.rktl")
(let loop ([l number-table]) (check-all-numbers number-table)
(unless (null? l)
(let* ([pair (car l)] ;; single-flonums disabled by default
[v (car pair)] (check-all-numbers '((10.0 "1f1")
[s (cadr pair)]) (10.0 "#i1f1")))
(for ([s (in-list (list s (string-upcase s)))])
(cond (when (single-flonum-available?)
[(memq v '(X DBZ NOE)) (parameterize ([read-single-flonum #t])
(err/rt-test (readstr s) exn:fail:read?) (define def (call-with-input-file*
(test #f string->number s) (build-path (or (current-load-relative-directory)
(test #t string? (string->number s 10 'read))] (current-directory))
[v "numstrs.rktl")
(test v readstr s) (lambda (i) (read i))))
(test (if (symbol? v) #f v) string->number s) (check-all-numbers (eval (caddr def)))))
(test (if (symbol? v) #f v) string->number s 10 'read)]
[else (unless (single-flonum-available?)
(test (string->symbol s) readstr s) (parameterize ([read-single-flonum #t])
(test #f string->number s) (err/rt-test (read (open-input-string "3.4f5"))
(test #f string->number s 10 'read) exn:fail:unsupported?)))
(unless (regexp-match "#" s)
(err/rt-test (readstr (string-append "#d" s)) exn:fail:read?) (test 5 string->number "5" 10 'number-or-false)
(test #f string->number (string-append "#d" s)) (test 5 string->number "5.0" 10 'number-or-false 'decimal-as-exact)
(test #t string? (string->number (string-append "#d" s) 10 'read)))]))) (test 5.0 string->number "5.0" 10 'number-or-false 'decimal-as-inexact)
(loop (cdr l)))) (test 5.0 string->number "5.0f0" 10 'number-or-false 'decimal-as-inexact 'double)
(if (single-flonum-available?)
(test (real->single-flonum 5.0) string->number "5.0f0" 10 'number-or-false 'decimal-as-inexact 'single)
(err/rt-test (string->number "5.0f0" 10 'number-or-false 'decimal-as-inexact 'single)
exn:fail:unsupported?))
(define (make-exn:fail:read:eof?/span start span) (define (make-exn:fail:read:eof?/span start span)
(lambda (exn) (lambda (exn)

13
pkgs/racket-test/tests/racket/contract/flat-contracts.rkt
View File

@ -97,15 +97,20 @@
(test-flat-contract #\a #\a #\b #:skip-predicate-checks? #t) (test-flat-contract #\a #\a #\b #:skip-predicate-checks? #t)
(test-flat-contract #\a #\a 'a #:skip-predicate-checks? #t) (test-flat-contract #\a #\a 'a #:skip-predicate-checks? #t)
(test-flat-contract ''a 'a 'b #:skip-predicate-checks? #t) (test-flat-contract ''a 'a 'b #:skip-predicate-checks? #t)
(let ([a #\⊢]) (let* ([a #\⊢]
(test-flat-contract a (integer->char (char->integer a)) #\a #:skip-predicate-checks? #t)) [b (integer->char (+ (char->integer a) (random 1)))])
(test-flat-contract a b #\a #:skip-predicate-checks? #t))
(test-flat-contract ''a 'a #\a #:skip-predicate-checks? #t) (test-flat-contract ''a 'a #\a #:skip-predicate-checks? #t)
(test-flat-contract "x" "x" "y" #:skip-predicate-checks? #t) (test-flat-contract "x" "x" "y" #:skip-predicate-checks? #t)
(test-flat-contract "x" "x" 'x #:skip-predicate-checks? #t) (test-flat-contract "x" "x" 'x #:skip-predicate-checks? #t)
(test-flat-contract 1 1 2 #:skip-predicate-checks? #t) (test-flat-contract 1 1 2 #:skip-predicate-checks? #t)
(test-flat-contract #e1 #i1.0 'x #:skip-predicate-checks? #t) (test-flat-contract #e1 #i1.0 'x #:skip-predicate-checks? #t)
(test-flat-contract +nan.0 +nan.0 +nan.f #:skip-predicate-checks? #t) (test-flat-contract +nan.0 +nan.0 +inf.0 #:skip-predicate-checks? #t)
(test-flat-contract +nan.f +nan.f +nan.0 #:skip-predicate-checks? #t) (test-flat-contract +inf.0 +inf.0 +nan.0 #:skip-predicate-checks? #t)
#reader tests/racket/maybe-single
(when (single-flonum-available?)
(test-flat-contract +nan.0 +nan.0 +nan.f #:skip-predicate-checks? #t)
(test-flat-contract +nan.f +nan.f +nan.0 #:skip-predicate-checks? #t))
(test-flat-contract #rx".x." "axq" "x" #:skip-predicate-checks? #t) (test-flat-contract #rx".x." "axq" "x" #:skip-predicate-checks? #t)
(test-flat-contract #rx#".x." #"axq" #"x" #:skip-predicate-checks? #t) (test-flat-contract #rx#".x." #"axq" #"x" #:skip-predicate-checks? #t)
(test-flat-contract #rx".x." #"axq" #"x" #:skip-predicate-checks? #t) (test-flat-contract #rx".x." #"axq" #"x" #:skip-predicate-checks? #t)

1
pkgs/zo-lib/compiler/zo-parse.rkt
View File

@ -406,6 +406,7 @@
[read-square-bracket-as-paren #t] [read-square-bracket-as-paren #t]
[read-curly-brace-as-paren #t] [read-curly-brace-as-paren #t]
[read-decimal-as-inexact #t] [read-decimal-as-inexact #t]
[read-single-flonum (single-flonum-available?)] ;; not the default!
[read-accept-dot #t] [read-accept-dot #t]
[read-accept-infix-dot #t] [read-accept-infix-dot #t]
[read-accept-quasiquote #t] [read-accept-quasiquote #t]

4
racket/collects/racket/HISTORY.txt
View File

@ -1,3 +1,7 @@
Version 7.4
Disabled single-flonum reading by default and added
`read-single-flonum` and `single-flonum-available?`
Version 7.3, May 2019 Version 7.3, May 2019
Bug repairs and other changes noted in the documentation Bug repairs and other changes noted in the documentation

12
racket/collects/racket/contract/private/generate-base.rkt
View File

@ -15,7 +15,9 @@
env-item-ctc env-item-ctc
predicate-generator-table predicate-generator-table
exact-nonnegative-integer-gen) exact-nonnegative-integer-gen
all-zeros)
;; generate ;; generate
@ -167,4 +169,10 @@
[else (cons (string->symbol (string-append "x-" (number->string st-num))) [else (cons (string->symbol (string-append "x-" (number->string st-num)))
(gen-arg-names (+ st-num 1) (- size 1)))])) (gen-arg-names (+ st-num 1) (- size 1)))]))
(define all-zeros
(if (single-flonum-available?)
(list 0
-0.0 0.0 (real->single-flonum 0.0) (real->single-flonum -0.0)
0.0+0.0i (make-rectangular (real->single-flonum 0.0) (real->single-flonum 0.0))
0+0.0i 0.0+0i)
'(0 -0.0 0.0 0.0+0.0i 0+0.0i 0.0+0i)))

10
racket/collects/racket/contract/private/guts.rkt
View File

@ -437,7 +437,7 @@
x) x)
name))] name))]
[(char? x) (make-char-in/c x x)] [(char? x) (make-char-in/c x x)]
[(or (bytes? x) (string? x) (equal? +nan.0 x) (equal? +nan.f x)) [(or (bytes? x) (string? x) (and (real? x) (nan? x)))
(make-equal-contract x (if (name-default? name) x name))] (make-equal-contract x (if (name-default? name) x name))]
[(number? x) [(number? x)
(make-=-contract x (if (name-default? name) x name))] (make-=-contract x (if (name-default? name) x name))]
@ -659,21 +659,17 @@
[(zero? v) [(zero? v)
;; zero has a whole bunch of different numbers that ;; zero has a whole bunch of different numbers that
;; it could be, so just pick one of them at random ;; it could be, so just pick one of them at random
(λ () (λ () (oneof all-zeros))]
(oneof '(0
-0.0 0.0 0.0f0 -0.0f0
0.0+0.0i 0.0f0+0.0f0i 0+0.0i 0.0+0i)))]
[else [else
(λ () (λ ()
(case (random 10) (case (random 10)
[(0) [(0)
(define inf/nan '(+inf.0 -inf.0 +inf.f -inf.f +nan.0 +nan.f))
;; try the inexact/exact variant (if there is one) ;; try the inexact/exact variant (if there is one)
(cond (cond
[(exact? v) [(exact? v)
(define iv (exact->inexact v)) (define iv (exact->inexact v))
(if (= iv v) iv v)] (if (= iv v) iv v)]
[(and (inexact? v) (not (memv v inf/nan))) [(and (inexact? v) (not (infinite? v)) (not (nan? v)))
(define ev (inexact->exact v)) (define ev (inexact->exact v))
(if (= ev v) ev v)] (if (= ev v) ev v)]
[else v])] [else v])]

8
racket/collects/racket/contract/private/opt.rkt
View File

@ -82,10 +82,14 @@
[(and (pair? konst) (eq? (car konst) 'quote)) [(and (pair? konst) (eq? (car konst) 'quote))
(values #`(eq? #,konst #,v) (values #`(eq? #,konst #,v)
"eq?")] "eq?")]
[(or (boolean? konst) (char? konst) (null? konst)) [(or (boolean? konst) (null? konst))
(values #`(eq? #,konst #,v) (values #`(eq? #,konst #,v)
"eq?")] "eq?")]
[(or (string? konst) (bytes? konst) (equal? konst +nan.0) (equal? konst +nan.f)) [(or (char? konst) (equal? konst +nan.0) (and (single-flonum-available?)
(equal? konst (real->single-flonum +nan.0))))
(values #`(eqv? #,konst #,v)
"eqv?")]
[(or (string? konst) (bytes? konst))
(values #`(equal? #,konst #,v) (values #`(equal? #,konst #,v)
"equal?")] "equal?")]
[(number? konst) [(number? konst)

18
racket/collects/racket/math.rkt
View File

@ -23,7 +23,9 @@
order-of-magnitude) order-of-magnitude)
(define pi (atan 0 -1)) (define pi (atan 0 -1))
(define pi.f (atan 0.0f0 -1.0f0)) (define pi.f (if (single-flonum-available?)
(atan (real->single-flonum 0.0) (real->single-flonum -1.0))
pi))
(begin-encourage-inline (begin-encourage-inline
@ -39,9 +41,9 @@
[(double-flonum? x) (cond [(unsafe-fl> x 0.0) 1.0] [(double-flonum? x) (cond [(unsafe-fl> x 0.0) 1.0]
[(unsafe-fl< x 0.0) -1.0] [(unsafe-fl< x 0.0) -1.0]
[else +nan.0])] [else +nan.0])]
[(single-flonum? x) (cond [(> x 0.0f0) 1.0f0] [(single-flonum? x) (cond [(> x 0.0f0) (real->single-flonum 1.0)]
[(< x 0.0f0) -1.0f0] [(< x 0.0f0) (real->single-flonum -1.0)]
[else +nan.f])] [else (real->single-flonum +nan.0)])]
[else (if (> x 0) 1 -1)])) [else (if (> x 0) 1 -1)]))
;; complex conjugate ;; complex conjugate
@ -61,7 +63,7 @@
(define (cosh z) (define (cosh z)
(unless (number? z) (raise-argument-error 'cosh "number?" z)) (unless (number? z) (raise-argument-error 'cosh "number?" z))
(cond [(and (real? z) (= z 0)) (if (single-flonum? z) 1.0f0 1.0)] (cond [(and (real? z) (= z 0)) (if (single-flonum? z) (real->single-flonum 1.0) 1.0)]
[else (/ (+ (exp z) (exp (- z))) 2)])) [else (/ (+ (exp z) (exp (- z))) 2)]))
(define (tanh z) (define (tanh z)
@ -85,19 +87,19 @@
(+ (* (+ (* (+ g q2) g) q1) g) q0))) (+ (* (+ (* (+ g q2) g) q1) g) q0)))
(+ z (* z R))] (+ z (* z R))]
[(z . < . 19.06154746539849600897D+00) (- 1 (/ 2 (+ 1 (exp (* 2 z)))))] [(z . < . 19.06154746539849600897D+00) (- 1 (/ 2 (+ 1 (exp (* 2 z)))))]
[(z . >= . 19.06154746539849600897D+00) (if (single-flonum? z) 1.0f0 1.0)] [(z . >= . 19.06154746539849600897D+00) (if (single-flonum? z) (real->single-flonum 1.0) 1.0)]
[else z]))] ; +nan.0 or +nan.f [else z]))] ; +nan.0 or +nan.f
[else (- 1 (/ 2 (+ 1 (exp (* 2 z)))))])) [else (- 1 (/ 2 (+ 1 (exp (* 2 z)))))]))
;; angle conversion ;; angle conversion
(define (degrees->radians x) (define (degrees->radians x)
(unless (real? x) (raise-argument-error 'degrees->radians "real?" x)) (unless (real? x) (raise-argument-error 'degrees->radians "real?" x))
(cond [(single-flonum? x) (* x (/ pi.f 180f0))] (cond [(single-flonum? x) (* x (/ pi.f (real->single-flonum 180.0)))]
[else (* x (/ pi 180.0))])) [else (* x (/ pi 180.0))]))
(define (radians->degrees x) (define (radians->degrees x)
(unless (real? x) (raise-argument-error 'radians->degrees "real?" x)) (unless (real? x) (raise-argument-error 'radians->degrees "real?" x))
(cond [(single-flonum? x) (* x (/ 180f0 pi.f))] (cond [(single-flonum? x) (* x (/ (real->single-flonum 180.0) pi.f))]
[else (* x (/ 180.0 pi))])) [else (* x (/ 180.0 pi))]))
;; inexact->exact composed with round, floor, ceiling, truncate ;; inexact->exact composed with round, floor, ceiling, truncate

5
racket/collects/racket/private/math-predicates.rkt
View File

@ -16,7 +16,8 @@
;; real predicates ;; real predicates
(define (nan? x) (define (nan? x)
(unless (real? x) (raise-argument-error 'nan? "real?" x)) (unless (real? x) (raise-argument-error 'nan? "real?" x))
(or (eqv? x +nan.0) (eqv? x +nan.f))) (or (eqv? x +nan.0) (and (single-flonum-available?)
(eqv? x (real->single-flonum +nan.0)))))
(define (infinite? x) (define (infinite? x)
(unless (real? x) (raise-argument-error 'infinite? "real?" x)) (unless (real? x) (raise-argument-error 'infinite? "real?" x))
@ -35,4 +36,4 @@
(and (integer? x) (not (negative? x)))) (and (integer? x) (not (negative? x))))
(define (natural? x) (define (natural? x)
(exact-nonnegative-integer? x))) (exact-nonnegative-integer? x)))

1
racket/collects/racket/private/reading-param.rkt
View File

@ -16,6 +16,7 @@
[read-accept-bar-quote #t] [read-accept-bar-quote #t]
[read-accept-graph #t] [read-accept-graph #t]
[read-decimal-as-inexact #t] [read-decimal-as-inexact #t]
[read-single-flonum #f]
[read-cdot #f] [read-cdot #f]
[read-accept-dot #t] [read-accept-dot #t]
[read-accept-infix-dot #t] [read-accept-infix-dot #t]

9
racket/src/cify/generate.rkt
View File

@ -991,9 +991,12 @@
[(eqv? e +inf.0) "scheme_inf_object"] [(eqv? e +inf.0) "scheme_inf_object"]
[(eqv? e -inf.0) "scheme_minus_inf_object"] [(eqv? e -inf.0) "scheme_minus_inf_object"]
[(eqv? e +nan.0) "scheme_nan_object"] [(eqv? e +nan.0) "scheme_nan_object"]
[(eqv? e +inf.f) "scheme_single_inf_object"] [(and (sinfle-flonum-available?) (eqv? e (real->single-flonum +inf.0)))
[(eqv? e -inf.f) "scheme_single_minus_inf_object"] "scheme_single_inf_object"]
[(eqv? e +nan.f) "scheme_single_nan_object"] [(and (sinfle-flonum-available?) (eqv? e (real->single-flonum -inf.0)))
"scheme_single_minus_inf_object"]
[(and (sinfle-flonum-available?) (eqv? e (real->single-flonum +nan.0)))
"scheme_single_nan_object"]
[else [else
(format "scheme_make_double(~a)" e)])] (format "scheme_make_double(~a)" e)])]
[(boolean? e) (if e "scheme_true" "scheme_false")] [(boolean? e) (if e "scheme_true" "scheme_false")]

1
racket/src/cs/primitive/kernel.ss
View File

@ -764,6 +764,7 @@
[simplify-path (known-procedure 6)] [simplify-path (known-procedure 6)]
[sin (known-procedure 2)] [sin (known-procedure 2)]
[single-flonum? (known-procedure/pure 2)] [single-flonum? (known-procedure/pure 2)]
[single-flonum-available? (known-procedure/pure 1)]
[sleep (known-procedure 3)] [sleep (known-procedure 3)]
[split-path (known-procedure 2)] [split-path (known-procedure 2)]
[sqrt (known-procedure 2)] [sqrt (known-procedure 2)]

1
racket/src/cs/rumble.sls
View File

@ -371,6 +371,7 @@
byte? byte?
double-flonum? double-flonum?
single-flonum? single-flonum?
single-flonum-available?
real->double-flonum real->double-flonum
real->single-flonum real->single-flonum
arithmetic-shift arithmetic-shift

4
racket/src/cs/rumble/number.ss
View File

@ -10,13 +10,15 @@
(define (double-flonum? x) (flonum? x)) (define (double-flonum? x) (flonum? x))
(define (single-flonum? x) #f) (define (single-flonum? x) #f)
(define (single-flonum-available?) #f)
(define/who (real->double-flonum x) (define/who (real->double-flonum x)
(check who real? x) (check who real? x)
(exact->inexact x)) (exact->inexact x))
(define/who (real->single-flonum x) (define/who (real->single-flonum x)
(check who real? x) (check who real? x)
(exact->inexact x)) (raise-unsupported-error who))
(define arithmetic-shift #2%bitwise-arithmetic-shift) (define arithmetic-shift #2%bitwise-arithmetic-shift)

1
racket/src/expander/boot/read-primitive.rkt
View File

@ -32,6 +32,7 @@
read-accept-box read-accept-box
;; read-accept-bar-quote - shared with printer ;; read-accept-bar-quote - shared with printer
read-decimal-as-inexact read-decimal-as-inexact
read-single-flonum
read-accept-dot read-accept-dot
read-accept-infix-dot read-accept-infix-dot
read-accept-quasiquote read-accept-quasiquote

54
racket/src/expander/read/number.rkt
View File

@ -23,7 +23,10 @@
[convert-mode 'number-or-false] [convert-mode 'number-or-false]
[decimal-mode (if (read-decimal-as-inexact) [decimal-mode (if (read-decimal-as-inexact)
'decimal-as-inexact 'decimal-as-inexact
'decimal-as-exact)]) 'decimal-as-exact)]
[single-mode (if (read-single-flonum)
'single
'double)])
(check who string? s) (check who string? s)
(check who (lambda (p) (and (exact-integer? radix) (check who (lambda (p) (and (exact-integer? radix)
(<= 2 radix 16))) (<= 2 radix 16)))
@ -35,20 +38,26 @@
convert-mode) convert-mode)
(check who (lambda (p) (or (eq? p 'decimal-as-inexact) (check who (lambda (p) (or (eq? p 'decimal-as-inexact)
(eq? p 'decimal-as-exact))) (eq? p 'decimal-as-exact)))
#:contract "(or/c 'decimal-as-inexact decimal-as-exact)" #:contract "(or/c 'decimal-as-inexact 'decimal-as-exact)"
decimal-mode) decimal-mode)
(unchecked-string->number s radix convert-mode decimal-mode)) (check who (lambda (p) (or (eq? p 'single)
(eq? p 'double)))
#:contract "(or/c 'single 'double)"
single-mode)
(unchecked-string->number s radix convert-mode decimal-mode single-mode))
(define (unchecked-string->number s radix convert-mode decimal-mode) (define (unchecked-string->number s radix convert-mode decimal-mode single-mode)
(do-string->number s 0 (string-length s) (do-string->number s 0 (string-length s)
radix #:radix-set? #f radix #:radix-set? #f
decimal-mode decimal-mode
convert-mode)) convert-mode
single-mode))
;; ---------------------------------------- ;; ----------------------------------------
(struct parse-state (exactness ; see below (struct parse-state (exactness ; see below
convert-mode ; 'number-or-false, 'read, or 'must-read convert-mode ; 'number-or-false, 'read, or 'must-read
can-single? ; whether 3.4f0 reads as single-flonum or not
fst ; rect-prefix, polar-prefix, '+/- if started with sign, or #f fst ; rect-prefix, polar-prefix, '+/- if started with sign, or #f
other-exactness) ; exactness to use for the imag part or saved real part other-exactness) ; exactness to use for the imag part or saved real part
#:authentic) #:authentic)
@ -69,8 +78,8 @@
;; - 'extflonum->inexact ; => was 'inexact and found "t" ;; - 'extflonum->inexact ; => was 'inexact and found "t"
;; - 'extflonum->exact ; => was 'exact and found "t" ;; - 'extflonum->exact ; => was 'exact and found "t"
(define (init-state exactness convert-mode fst) (define (init-state exactness convert-mode single-mode fst)
(parse-state exactness convert-mode fst exactness)) (parse-state exactness convert-mode (eq? single-mode 'single) fst exactness))
(define (state-has-first-half? state) (define (state-has-first-half? state)
(define fst (parse-state-fst state)) (define fst (parse-state-fst state))
@ -85,11 +94,13 @@
(define (state-first-half state) (define (state-first-half state)
(init-state (parse-state-other-exactness state) (init-state (parse-state-other-exactness state)
(parse-state-convert-mode state) (parse-state-convert-mode state)
(if (parse-state-can-single? state) 'single 'double)
#f)) #f))
(define (state-second-half state) (define (state-second-half state)
(init-state (parse-state-exactness state) (init-state (parse-state-exactness state)
(parse-state-convert-mode state) (parse-state-convert-mode state)
(if (parse-state-can-single? state) 'single 'double)
#f)) #f))
;; ---------------------------------------- ;; ----------------------------------------
@ -265,7 +276,15 @@
[(single) [(single)
(maybe (force-lazy-inexact sgn/z n state s) (maybe (force-lazy-inexact sgn/z n state s)
(lambda (r) (lambda (r)
(real->single-flonum r)))] (if (parse-state-can-single? state)
(if (single-flonum-available?)
(real->single-flonum r)
(raise (exn:fail:unsupported
(string-append
"read: single-flonums are not supported on this platform\n"
" conversion from: " (number->string r))
(current-continuation-marks))))
(exact->inexact r))))]
[(exact) [(exact)
(case n (case n
[(+inf.0 -inf.0 +nan.0) [(+inf.0 -inf.0 +nan.0)
@ -425,13 +444,14 @@
(define (do-string->number s start end (define (do-string->number s start end
radix #:radix-set? radix-set? radix #:radix-set? radix-set?
exactness ; 'inexact, 'exact, 'decimal-as-inexact, or 'decimal-as-exact exactness ; 'inexact, 'exact, 'decimal-as-inexact, or 'decimal-as-exact
convert-mode) convert-mode
single-mode)
(parse-case (parse-case
s start end radix => c s start end radix => c
[(eof) [(eof)
(fail convert-mode "no digits")] (fail convert-mode "no digits")]
[(digit) [(digit)
(read-integer 1 c s (fx+ 1 start) end radix (init-state exactness convert-mode #f))] (read-integer 1 c s (fx+ 1 start) end radix (init-state exactness convert-mode single-mode #f))]
[(#\#) [(#\#)
(define next (fx+ 1 start)) (define next (fx+ 1 start))
(parse-case (parse-case
@ -447,7 +467,8 @@
(do-string->number s (fx+ 1 next) end (do-string->number s (fx+ 1 next) end
radix #:radix-set? radix-set? radix #:radix-set? radix-set?
(if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact) (if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact)
(if (eq? convert-mode 'read) 'must-read convert-mode))])] (if (eq? convert-mode 'read) 'must-read convert-mode)
single-mode)])]
[(#\b #\B #\o #\O #\d #\D #\x #\X) [(#\b #\B #\o #\O #\d #\D #\x #\X)
(cond (cond
[radix-set? [radix-set?
@ -462,17 +483,20 @@
(do-string->number s (fx+ 1 next) end (do-string->number s (fx+ 1 next) end
radix #:radix-set? #t radix #:radix-set? #t
exactness exactness
(if (eq? convert-mode 'read) 'must-read convert-mode))])] (if (eq? convert-mode 'read) 'must-read convert-mode)
single-mode)])]
[else [else
;; The reader always complains about a bad leading `#` ;; The reader always complains about a bad leading `#`
(fail (if (eq? convert-mode 'read) 'must-read convert-mode) (fail (if (eq? convert-mode 'read) 'must-read convert-mode)
"bad `#` indicator `~a` at `~.a`" i (substring s start end))])] "bad `#` indicator `~a` at `~.a`" i (substring s start end))])]
[(#\+) [(#\+)
(read-signed 1 s (fx+ 1 start) end radix (init-state exactness convert-mode '+/-))] (read-signed 1 s (fx+ 1 start) end radix (init-state exactness convert-mode single-mode '+/-))]
[(#\-) [(#\-)
(read-signed -1 s (fx+ 1 start) end radix (init-state exactness convert-mode '+/-))] (read-signed -1 s (fx+ 1 start) end radix (init-state exactness convert-mode single-mode '+/-))]
[(#\.) [(#\.)
(read-decimal 1 #f 0 s (fx+ 1 start) end radix (set-exactness (init-state exactness convert-mode #f) 'approx))] (read-decimal 1 #f 0 s (fx+ 1 start) end radix (set-exactness
(init-state exactness convert-mode single-mode #f)
'approx))]
[else [else
(bad-digit c s convert-mode)])) (bad-digit c s convert-mode)]))

1
racket/src/expander/read/parameter.rkt
View File

@ -48,6 +48,7 @@
(check-parameter read-accept-box config) (check-parameter read-accept-box config)
(check-parameter read-accept-bar-quote config) (check-parameter read-accept-bar-quote config)
(check-parameter read-decimal-as-inexact config) (check-parameter read-decimal-as-inexact config)
(check-parameter read-single-flonum config)
(check-parameter read-accept-dot config) (check-parameter read-accept-dot config)
(check-parameter read-accept-infix-dot config) (check-parameter read-accept-infix-dot config)
(check-parameter read-accept-quasiquote config) (check-parameter read-accept-quasiquote config)

1
racket/src/expander/read/primitive-parameter.rkt
View File

@ -28,6 +28,7 @@
(define-boolean-parameter read-accept-compiled #f) (define-boolean-parameter read-accept-compiled #f)
(define-boolean-parameter read-accept-box #t) (define-boolean-parameter read-accept-box #t)
;; (define-boolean-parameter read-accept-bar-quote #t) - shared with printer ;; (define-boolean-parameter read-accept-bar-quote #t) - shared with printer
(define-boolean-parameter read-single-flonum #f)
(define-boolean-parameter read-decimal-as-inexact #t) (define-boolean-parameter read-decimal-as-inexact #t)
(define-boolean-parameter read-accept-dot #t) (define-boolean-parameter read-accept-dot #t)
(define-boolean-parameter read-accept-infix-dot #t) (define-boolean-parameter read-accept-infix-dot #t)

5
racket/src/expander/read/symbol-or-number.rkt
View File

@ -121,7 +121,10 @@
'read 'read
(if (check-parameter read-decimal-as-inexact config) (if (check-parameter read-decimal-as-inexact config)
'decimal-as-inexact 'decimal-as-inexact
'decimal-as-exact)))) 'decimal-as-exact)
(if (check-parameter read-single-flonum config)
'single
'double))))
(when (string? num) (when (string? num)
(reader-error in config "~a" num)) (reader-error in config "~a" num))

15
racket/src/racket/src/number.c
View File

@ -203,6 +203,8 @@ static Scheme_Object *extfl_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *exact_to_extfl(int argc, Scheme_Object *argv[]); static Scheme_Object *exact_to_extfl(int argc, Scheme_Object *argv[]);
#endif #endif
static Scheme_Object *single_flonum_available_p(int argc, Scheme_Object *argv[]);
/* globals */ /* globals */
READ_ONLY Scheme_Object *scheme_unsafe_fxnot_proc; READ_ONLY Scheme_Object *scheme_unsafe_fxnot_proc;
READ_ONLY Scheme_Object *scheme_unsafe_fxand_proc; READ_ONLY Scheme_Object *scheme_unsafe_fxand_proc;
@ -739,6 +741,9 @@ scheme_init_number (Scheme_Startup_Env *env)
p = scheme_make_folding_prim(scheme_inexact_to_exact, "inexact->exact", 1, 1, 1); p = scheme_make_folding_prim(scheme_inexact_to_exact, "inexact->exact", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_addto_prim_instance("inexact->exact", p, env); scheme_addto_prim_instance("inexact->exact", p, env);
p = scheme_make_folding_prim(single_flonum_available_p, "single-flonum-available?", 0, 0, 1);
scheme_addto_prim_instance("single-flonum-available?", p, env);
} }
void scheme_init_flfxnum_number(Scheme_Startup_Env *env) void scheme_init_flfxnum_number(Scheme_Startup_Env *env)
@ -2126,6 +2131,16 @@ real_to_long_double_flonum (int argc, Scheme_Object *argv[])
#endif #endif
} }
static Scheme_Object *single_flonum_available_p(int argc, Scheme_Object *argv[])
{
#ifdef MZ_USE_SINGLE_FLOATS
return scheme_true;
#else
return scheme_false;
#endif
}
int scheme_is_exact(const Scheme_Object *n) int scheme_is_exact(const Scheme_Object *n)
{ {
if (SCHEME_INTP(n)) { if (SCHEME_INTP(n)) {

2
racket/src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1452 #define EXPECTED_PRIM_COUNT 1453
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

2
racket/src/racket/src/schvers.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_W 5
/* A level of indirection makes `#` work as needed: */ /* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x #define AS_a_STR_HELPER(x) #x

526
racket/src/racket/src/startup.inc
View File

@ -622,6 +622,8 @@ static const char *startup_source =
" #t" " #t"
" 1/read-decimal-as-inexact" " 1/read-decimal-as-inexact"
" #t" " #t"
" 1/read-single-flonum"
" #f"
" 1/read-cdot" " 1/read-cdot"
" #f" " #f"
" 1/read-accept-dot" " 1/read-accept-dot"
@ -52365,6 +52367,7 @@ static const char *startup_source =
"(define-values(1/read-accept-graph)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-accept-graph)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-accept-compiled)(make-parameter #f(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-accept-compiled)(make-parameter #f(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-accept-box)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-accept-box)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-single-flonum)(make-parameter #f(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-decimal-as-inexact)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-decimal-as-inexact)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-accept-dot)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-accept-dot)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))"
"(define-values(1/read-accept-infix-dot)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))" "(define-values(1/read-accept-infix-dot)(make-parameter #t(lambda(v_0)(if v_0 #t #f))))"
@ -52439,6 +52442,7 @@ static const char *startup_source =
"(check-parameter 1/read-accept-box config_0)" "(check-parameter 1/read-accept-box config_0)"
"(check-parameter read-accept-bar-quote config_0)" "(check-parameter read-accept-bar-quote config_0)"
"(check-parameter 1/read-decimal-as-inexact config_0)" "(check-parameter 1/read-decimal-as-inexact config_0)"
"(check-parameter 1/read-single-flonum config_0)"
"(check-parameter 1/read-accept-dot config_0)" "(check-parameter 1/read-accept-dot config_0)"
"(check-parameter 1/read-accept-infix-dot config_0)" "(check-parameter 1/read-accept-infix-dot config_0)"
"(check-parameter 1/read-accept-quasiquote config_0)" "(check-parameter 1/read-accept-quasiquote config_0)"
@ -54002,28 +54006,32 @@ static const char *startup_source =
"(define-values(string->number$1) string->number)" "(define-values(string->number$1) string->number)"
"(define-values" "(define-values"
"(1/string->number)" "(1/string->number)"
"(let-values(((string->number5_0)" "(let-values(((string->number6_0)"
"(lambda(s4_0 radix1_0 convert-mode2_0 decimal-mode3_0)" "(lambda(s5_0 radix1_0 convert-mode2_0 decimal-mode3_0 single-mode4_0)"
"(begin" "(begin"
" 'string->number5" " 'string->number6"
"(let-values(((s_0) s4_0))" "(let-values(((s_0) s5_0))"
"(let-values(((radix_0) radix1_0))" "(let-values(((radix_0) radix1_0))"
"(let-values(((convert-mode_0) convert-mode2_0))" "(let-values(((convert-mode_0) convert-mode2_0))"
"(let-values(((decimal-mode_0)" "(let-values(((decimal-mode_0)"
"(if(eq? decimal-mode3_0 unsafe-undefined)" "(if(eq? decimal-mode3_0 unsafe-undefined)"
"(if(1/read-decimal-as-inexact) 'decimal-as-inexact 'decimal-as-exact)" "(if(1/read-decimal-as-inexact) 'decimal-as-inexact 'decimal-as-exact)"
" decimal-mode3_0)))" " decimal-mode3_0)))"
"(let-values(((single-mode_0)"
"(if(eq? single-mode4_0 unsafe-undefined)"
"(if(1/read-single-flonum) 'single 'double)"
" single-mode4_0)))"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
"(begin" "(begin"
"(if(string? s_0)" "(if(string? s_0)"
"(void)" "(void)"
" (let-values () (raise-argument-error 'string->number \"string?\" s_0)))" " (let-values () (raise-argument-error 'string->number \"string?\" s_0)))"
"(if((lambda(p_0)(if(exact-integer? radix_0)(<= 2 radix_0 16) #f)) radix_0)" "(if((lambda(p_0)(if(exact-integer? radix_0)(<= 2 radix_0 16) #f)) radix_0)"
"(void)" "(void)"
"(let-values()" "(let-values()"
" (raise-argument-error 'string->number \"(integer-in 2 16)\" radix_0)))" " (raise-argument-error 'string->number \"(integer-in 2 16)\" radix_0)))"
"(if((lambda(p_0)" "(if((lambda(p_0)"
"(let-values(((or-part_0)(eq? p_0 'number-or-false)))" "(let-values(((or-part_0)(eq? p_0 'number-or-false)))"
"(if or-part_0 or-part_0(eq? p_0 'read))))" "(if or-part_0 or-part_0(eq? p_0 'read))))"
@ -54032,7 +54040,7 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(raise-argument-error" "(raise-argument-error"
" 'string->number" " 'string->number"
" \"(or/c 'number-or-false 'read)\"" " \"(or/c 'number-or-false 'read)\""
" convert-mode_0)))" " convert-mode_0)))"
"(if((lambda(p_0)" "(if((lambda(p_0)"
"(let-values(((or-part_0)(eq? p_0 'decimal-as-inexact)))" "(let-values(((or-part_0)(eq? p_0 'decimal-as-inexact)))"
@ -54042,32 +54050,60 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(raise-argument-error" "(raise-argument-error"
" 'string->number" " 'string->number"
" \"(or/c 'decimal-as-inexact decimal-as-exact)\"" " \"(or/c 'decimal-as-inexact 'decimal-as-exact)\""
" decimal-mode_0)))" " decimal-mode_0)))"
"(unchecked-string->number s_0 radix_0 convert-mode_0 decimal-mode_0)))))))))))))" "(if((lambda(p_0)"
"(let-values(((or-part_0)(eq? p_0 'single)))"
"(if or-part_0 or-part_0(eq? p_0 'double))))"
" single-mode_0)"
"(void)"
"(let-values()"
"(raise-argument-error"
" 'string->number"
" \"(or/c 'single 'double)\""
" single-mode_0)))"
"(unchecked-string->number"
" s_0"
" radix_0"
" convert-mode_0"
" decimal-mode_0"
" single-mode_0))))))))))))))"
"(case-lambda" "(case-lambda"
"((s_0)(begin 'string->number(string->number5_0 s_0 10 'number-or-false unsafe-undefined)))" "((s_0)(begin 'string->number(string->number6_0 s_0 10 'number-or-false unsafe-undefined unsafe-undefined)))"
"((s_0 radix_0 convert-mode_0 decimal-mode3_0)(string->number5_0 s_0 radix_0 convert-mode_0 decimal-mode3_0))" "((s_0 radix_0 convert-mode_0 decimal-mode_0 single-mode4_0)"
"((s_0 radix_0 convert-mode2_0)(string->number5_0 s_0 radix_0 convert-mode2_0 unsafe-undefined))" "(string->number6_0 s_0 radix_0 convert-mode_0 decimal-mode_0 single-mode4_0))"
"((s_0 radix1_0)(string->number5_0 s_0 radix1_0 'number-or-false unsafe-undefined)))))" "((s_0 radix_0 convert-mode_0 decimal-mode3_0)"
"(string->number6_0 s_0 radix_0 convert-mode_0 decimal-mode3_0 unsafe-undefined))"
"((s_0 radix_0 convert-mode2_0)(string->number6_0 s_0 radix_0 convert-mode2_0 unsafe-undefined unsafe-undefined))"
"((s_0 radix1_0)(string->number6_0 s_0 radix1_0 'number-or-false unsafe-undefined unsafe-undefined)))))"
"(define-values" "(define-values"
"(unchecked-string->number)" "(unchecked-string->number)"
"(lambda(s_0 radix_0 convert-mode_0 decimal-mode_0)" "(lambda(s_0 radix_0 convert-mode_0 decimal-mode_0 single-mode_0)"
"(begin" "(begin"
"(let-values(((s54_0) s_0)" "(let-values(((s56_0) s_0)"
"((temp55_0) 0)" "((temp57_0) 0)"
"((temp56_0)(string-length s_0))" "((temp58_0)(string-length s_0))"
"((radix57_0) radix_0)" "((radix59_0) radix_0)"
"((temp58_0) #f)" "((temp60_0) #f)"
"((decimal-mode59_0) decimal-mode_0)" "((decimal-mode61_0) decimal-mode_0)"
"((convert-mode60_0) convert-mode_0))" "((convert-mode62_0) convert-mode_0)"
"(do-string->number50.1 temp58_0 s54_0 temp55_0 temp56_0 radix57_0 decimal-mode59_0 convert-mode60_0)))))" "((single-mode63_0) single-mode_0))"
"(do-string->number52.1"
" temp60_0"
" s56_0"
" temp57_0"
" temp58_0"
" radix59_0"
" decimal-mode61_0"
" convert-mode62_0"
" single-mode63_0)))))"
"(define-values" "(define-values"
"(struct:parse-state" "(struct:parse-state"
" parse-state7.1" " parse-state8.1"
" parse-state?" " parse-state?"
" parse-state-exactness" " parse-state-exactness"
" parse-state-convert-mode" " parse-state-convert-mode"
" parse-state-can-single?"
" parse-state-fst" " parse-state-fst"
" parse-state-other-exactness)" " parse-state-other-exactness)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
@ -54076,13 +54112,13 @@ static const char *startup_source =
"(make-struct-type" "(make-struct-type"
" 'parse-state" " 'parse-state"
" #f" " #f"
" 4" " 5"
" 0" " 0"
" #f" " #f"
"(list(cons prop:authentic #t))" "(list(cons prop:authentic #t))"
"(current-inspector)" "(current-inspector)"
" #f" " #f"
" '(0 1 2 3)" " '(0 1 2 3 4)"
" #f" " #f"
" 'parse-state)))))" " 'parse-state)))))"
"(values" "(values"
@ -54091,10 +54127,11 @@ static const char *startup_source =
" ?_0" " ?_0"
"(make-struct-field-accessor -ref_0 0 'exactness)" "(make-struct-field-accessor -ref_0 0 'exactness)"
"(make-struct-field-accessor -ref_0 1 'convert-mode)" "(make-struct-field-accessor -ref_0 1 'convert-mode)"
"(make-struct-field-accessor -ref_0 2 'fst)" "(make-struct-field-accessor -ref_0 2 'can-single?)"
"(make-struct-field-accessor -ref_0 3 'other-exactness))))" "(make-struct-field-accessor -ref_0 3 'fst)"
"(make-struct-field-accessor -ref_0 4 'other-exactness))))"
"(define-values" "(define-values"
"(struct:rect-prefix rect-prefix8.1 rect-prefix? rect-prefix-sgn/z rect-prefix-n rect-prefix-start)" "(struct:rect-prefix rect-prefix9.1 rect-prefix? rect-prefix-sgn/z rect-prefix-n rect-prefix-start)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
@ -54118,7 +54155,7 @@ static const char *startup_source =
"(make-struct-field-accessor -ref_0 1 'n)" "(make-struct-field-accessor -ref_0 1 'n)"
"(make-struct-field-accessor -ref_0 2 'start))))" "(make-struct-field-accessor -ref_0 2 'start))))"
"(define-values" "(define-values"
"(struct:polar-prefix polar-prefix9.1 polar-prefix? polar-prefix-sgn/z polar-prefix-n polar-prefix-start)" "(struct:polar-prefix polar-prefix10.1 polar-prefix? polar-prefix-sgn/z polar-prefix-n polar-prefix-start)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
@ -54143,7 +54180,8 @@ static const char *startup_source =
"(make-struct-field-accessor -ref_0 2 'start))))" "(make-struct-field-accessor -ref_0 2 'start))))"
"(define-values" "(define-values"
"(init-state)" "(init-state)"
"(lambda(exactness_0 convert-mode_0 fst_0)(begin(parse-state7.1 exactness_0 convert-mode_0 fst_0 exactness_0))))" "(lambda(exactness_0 convert-mode_0 single-mode_0 fst_0)"
"(begin(parse-state8.1 exactness_0 convert-mode_0(eq? single-mode_0 'single) fst_0 exactness_0))))"
"(define-values" "(define-values"
"(state-has-first-half?)" "(state-has-first-half?)"
"(lambda(state_0)(begin(let-values(((fst_0)(parse-state-fst state_0)))(if fst_0(not(eq? fst_0 '+/-)) #f)))))" "(lambda(state_0)(begin(let-values(((fst_0)(parse-state-fst state_0)))(if fst_0(not(eq? fst_0 '+/-)) #f)))))"
@ -54153,17 +54191,34 @@ static const char *startup_source =
"(begin" "(begin"
"(let-values(((the-struct_0) state_0))" "(let-values(((the-struct_0) state_0))"
"(if(parse-state? the-struct_0)" "(if(parse-state? the-struct_0)"
"(let-values(((fst64_0) fst_0)" "(let-values(((fst67_0) fst_0)"
"((exactness65_0)(parse-state-other-exactness state_0))" "((exactness68_0)(parse-state-other-exactness state_0))"
"((other-exactness66_0)(parse-state-exactness state_0)))" "((other-exactness69_0)(parse-state-exactness state_0)))"
"(parse-state7.1 exactness65_0(parse-state-convert-mode the-struct_0) fst64_0 other-exactness66_0))" "(parse-state8.1"
" exactness68_0"
"(parse-state-convert-mode the-struct_0)"
"(parse-state-can-single? the-struct_0)"
" fst67_0"
" other-exactness69_0))"
" (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0))))))" " (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0))))))"
"(define-values" "(define-values"
"(state-first-half)" "(state-first-half)"
"(lambda(state_0)(begin(init-state(parse-state-other-exactness state_0)(parse-state-convert-mode state_0) #f))))" "(lambda(state_0)"
"(begin"
"(init-state"
"(parse-state-other-exactness state_0)"
"(parse-state-convert-mode state_0)"
"(if(parse-state-can-single? state_0) 'single 'double)"
" #f))))"
"(define-values" "(define-values"
"(state-second-half)" "(state-second-half)"
"(lambda(state_0)(begin(init-state(parse-state-exactness state_0)(parse-state-convert-mode state_0) #f))))" "(lambda(state_0)"
"(begin"
"(init-state"
"(parse-state-exactness state_0)"
"(parse-state-convert-mode state_0)"
"(if(parse-state-can-single? state_0) 'single 'double)"
" #f))))"
"(define-values" "(define-values"
"(state->convert-mode)" "(state->convert-mode)"
"(lambda(state_0)(begin(if(parse-state? state_0)(parse-state-convert-mode state_0) state_0))))" "(lambda(state_0)(begin(if(parse-state? state_0)(parse-state-convert-mode state_0) state_0))))"
@ -54215,7 +54270,7 @@ static const char *startup_source =
" (let-values () (format \"cannot combine extflonum `~a` into a complex number\" i_0))" " (let-values () (format \"cannot combine extflonum `~a` into a complex number\" i_0))"
"(let-values() #f)))))" "(let-values() #f)))))"
"(define-values" "(define-values"
"(struct:lazy-expt lazy-expt10.1 lazy-expt? lazy-expt-n lazy-expt-radix lazy-expt-exp)" "(struct:lazy-expt lazy-expt11.1 lazy-expt? lazy-expt-n lazy-expt-radix lazy-expt-exp)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
@ -54239,7 +54294,7 @@ static const char *startup_source =
"(make-struct-field-accessor -ref_0 1 'radix)" "(make-struct-field-accessor -ref_0 1 'radix)"
"(make-struct-field-accessor -ref_0 2 'exp))))" "(make-struct-field-accessor -ref_0 2 'exp))))"
"(define-values" "(define-values"
"(struct:lazy-rational lazy-rational11.1 lazy-rational? lazy-rational-n lazy-rational-d)" "(struct:lazy-rational lazy-rational12.1 lazy-rational? lazy-rational-n lazy-rational-d)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
@ -54265,7 +54320,7 @@ static const char *startup_source =
"(if(eq? n_0 'dbz!)" "(if(eq? n_0 'dbz!)"
"(let-values() n_0)" "(let-values() n_0)"
"(let-values()" "(let-values()"
"(if(if(< exp_0 30)(> exp_0 -30) #f)(* n_0(expt radix_0 exp_0))(lazy-expt10.1 n_0 radix_0 exp_0))))))))" "(if(if(< exp_0 30)(> exp_0 -30) #f)(* n_0(expt radix_0 exp_0))(lazy-expt11.1 n_0 radix_0 exp_0))))))))"
"(define-values" "(define-values"
"(lazy-divide)" "(lazy-divide)"
"(lambda(n_0 d_0 d-exactness_0)" "(lambda(n_0 d_0 d-exactness_0)"
@ -54273,7 +54328,7 @@ static const char *startup_source =
"(if(eqv? d_0 0)" "(if(eqv? d_0 0)"
"(let-values()(if(eq? d-exactness_0 'exact) 'dbz! 'dbz))" "(let-values()(if(eq? d-exactness_0 'exact) 'dbz! 'dbz))"
"(if(let-values(((or-part_0)(lazy-expt? n_0)))(if or-part_0 or-part_0(lazy-expt? d_0)))" "(if(let-values(((or-part_0)(lazy-expt? n_0)))(if or-part_0 or-part_0(lazy-expt? d_0)))"
"(let-values()(lazy-rational11.1 n_0 d_0))" "(let-values()(lazy-rational12.1 n_0 d_0))"
"(let-values()(/ n_0 d_0)))))))" "(let-values()(/ n_0 d_0)))))))"
"(define-values" "(define-values"
"(simplify-lazy-divide)" "(simplify-lazy-divide)"
@ -54305,15 +54360,15 @@ static const char *startup_source =
"(let-values() n_0)))))))" "(let-values() n_0)))))))"
"(define-values" "(define-values"
"(force-lazy-inexact)" "(force-lazy-inexact)"
"(let-values(((force-lazy-inexact17_0)" "(let-values(((force-lazy-inexact18_0)"
"(lambda(sgn/z13_0 n014_0 state15_0 s16_0 precision12_0)" "(lambda(sgn/z14_0 n015_0 state16_0 s17_0 precision13_0)"
"(begin" "(begin"
" 'force-lazy-inexact17" " 'force-lazy-inexact18"
"(let-values(((sgn/z_0) sgn/z13_0))" "(let-values(((sgn/z_0) sgn/z14_0))"
"(let-values(((n0_0) n014_0))" "(let-values(((n0_0) n015_0))"
"(let-values(((state_0) state15_0))" "(let-values(((state_0) state16_0))"
"(let-values(((s_0) s16_0))" "(let-values(((s_0) s17_0))"
"(let-values(((precision_0) precision12_0))" "(let-values(((precision_0) precision13_0))"
"(let-values()" "(let-values()"
"(let-values(((n1_0)(simplify-lazy-divide n0_0)))" "(let-values(((n1_0)(simplify-lazy-divide n0_0)))"
"(if(eq? n0_0 'dbz)" "(if(eq? n0_0 'dbz)"
@ -54349,8 +54404,8 @@ static const char *startup_source =
"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))" "(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))"
"(let-values() n1_0))))))))))))))))" "(let-values() n1_0))))))))))))))))"
"(case-lambda" "(case-lambda"
"((sgn/z_0 n0_0 state_0 s_0)(begin(force-lazy-inexact17_0 sgn/z_0 n0_0 state_0 s_0 2048)))" "((sgn/z_0 n0_0 state_0 s_0)(begin(force-lazy-inexact18_0 sgn/z_0 n0_0 state_0 s_0 2048)))"
"((sgn/z_0 n0_0 state_0 s_0 precision12_0)(force-lazy-inexact17_0 sgn/z_0 n0_0 state_0 s_0 precision12_0)))))" "((sgn/z_0 n0_0 state_0 s_0 precision13_0)(force-lazy-inexact18_0 sgn/z_0 n0_0 state_0 s_0 precision13_0)))))"
"(define-values" "(define-values"
"(fast-inexact)" "(fast-inexact)"
"(lambda(state_0 sgn_0 n_0 radix_0 exp_0 sgn2_0 exp2_0)" "(lambda(state_0 sgn_0 n_0 radix_0 exp_0 sgn2_0 exp2_0)"
@ -54381,15 +54436,15 @@ static const char *startup_source =
"(let-values() #f)))))" "(let-values() #f)))))"
"(let-values() #f))))))" "(let-values() #f))))))"
"(define-values" "(define-values"
"(finish25.1)" "(finish26.1)"
"(lambda(range19_0 sgn/z21_0 n22_0 s23_0 state24_0)" "(lambda(range20_0 sgn/z22_0 n23_0 s24_0 state25_0)"
"(begin" "(begin"
" 'finish25" " 'finish26"
"(let-values(((sgn/z_0) sgn/z21_0))" "(let-values(((sgn/z_0) sgn/z22_0))"
"(let-values(((n_0) n22_0))" "(let-values(((n_0) n23_0))"
"(let-values(((s_0) s23_0))" "(let-values(((s_0) s24_0))"
"(let-values(((state_0) state24_0))" "(let-values(((state_0) state25_0))"
"(let-values(((range_0) range19_0))" "(let-values(((range_0) range20_0))"
"(let-values()" "(let-values()"
"(let-values(((fst_0)(parse-state-fst state_0)))" "(let-values(((fst_0)(parse-state-fst state_0)))"
"(if(let-values(((or-part_0)(not fst_0)))(if or-part_0 or-part_0(eq? fst_0 '+/-)))" "(if(let-values(((or-part_0)(not fst_0)))(if or-part_0 or-part_0(eq? fst_0 '+/-)))"
@ -54400,7 +54455,19 @@ static const char *startup_source =
"(let-values(((v_0)(force-lazy-inexact sgn/z_0 n_0 state_0 s_0)))" "(let-values(((v_0)(force-lazy-inexact sgn/z_0 n_0 state_0 s_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(r_0)(real->single-flonum r_0)) v_0))))" "((lambda(r_0)"
"(if(parse-state-can-single? state_0)"
"(if(single-flonum-available?)"
"(real->single-flonum r_0)"
"(raise"
"(exn:fail:unsupported"
"(string-append"
" \"read: single-flonums are not supported on this platform\\n\""
" \" conversion from: \""
"(number->string r_0))"
"(current-continuation-marks))))"
"(exact->inexact r_0)))"
" v_0))))"
"(if(equal? tmp_0 'exact)" "(if(equal? tmp_0 'exact)"
"(let-values()" "(let-values()"
"(let-values(((tmp_1) n_0))" "(let-values(((tmp_1) n_0))"
@ -54456,19 +54523,19 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(let-values(((pos_0)(polar-prefix-start fst_0)))" "(let-values(((pos_0)(polar-prefix-start fst_0)))"
"(let-values(((m_0)" "(let-values(((m_0)"
"(let-values(((temp69_0)(polar-prefix-sgn/z fst_0))" "(let-values(((temp72_0)(polar-prefix-sgn/z fst_0))"
"((temp70_0)(polar-prefix-n fst_0))" "((temp73_0)(polar-prefix-n fst_0))"
"((s71_0) s_0)" "((s74_0) s_0)"
"((temp72_0)(state-first-half state_0))" "((temp75_0)(state-first-half state_0))"
"((temp73_0)(cons 0 pos_0)))" "((temp76_0)(cons 0 pos_0)))"
"(finish25.1 temp73_0 temp69_0 temp70_0 s71_0 temp72_0))))" "(finish26.1 temp76_0 temp72_0 temp73_0 s74_0 temp75_0))))"
"(let-values(((a_0)" "(let-values(((a_0)"
"(let-values(((sgn/z74_0) sgn/z_0)" "(let-values(((sgn/z77_0) sgn/z_0)"
"((n75_0) n_0)" "((n78_0) n_0)"
"((s76_0) s_0)" "((s79_0) s_0)"
"((temp77_0)(state-second-half state_0))" "((temp80_0)(state-second-half state_0))"
"((temp78_0)(cons pos_0(string-length s_0))))" "((temp81_0)(cons pos_0(string-length s_0))))"
"(finish25.1 temp78_0 sgn/z74_0 n75_0 s76_0 temp77_0))))" "(finish26.1 temp81_0 sgn/z77_0 n78_0 s79_0 temp80_0))))"
"(if(extflonum? m_0)" "(if(extflonum? m_0)"
"(let-values()(bad-extflonum-for-complex m_0 s_0 state_0))" "(let-values()(bad-extflonum-for-complex m_0 s_0 state_0))"
"(if(extflonum? a_0)" "(if(extflonum? a_0)"
@ -54505,8 +54572,8 @@ static const char *startup_source =
"(if(if(eq? fst_0 '+/-)(fx= start_0 end_0) #f)" "(if(if(eq? fst_0 '+/-)(fx= start_0 end_0) #f)"
"(let-values()" "(let-values()"
"(let-values(((v_0)" "(let-values(((v_0)"
"(let-values(((sgn/z79_0) sgn/z_0)((n80_0) n_0)((s81_0) s_0)((state82_0) state_0))" "(let-values(((sgn/z82_0) sgn/z_0)((n83_0) n_0)((s84_0) s_0)((state85_0) state_0))"
"(finish25.1 #f sgn/z79_0 n80_0 s81_0 state82_0))))" "(finish26.1 #f sgn/z82_0 n83_0 s84_0 state85_0))))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(i_0)" "((lambda(i_0)"
@ -54522,19 +54589,19 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(let-values(((pos_0)(rect-prefix-start fst_0)))" "(let-values(((pos_0)(rect-prefix-start fst_0)))"
"(let-values(((r_0)" "(let-values(((r_0)"
"(let-values(((temp83_0)(rect-prefix-sgn/z fst_0))" "(let-values(((temp86_0)(rect-prefix-sgn/z fst_0))"
"((temp84_0)(rect-prefix-n fst_0))" "((temp87_0)(rect-prefix-n fst_0))"
"((s85_0) s_0)" "((s88_0) s_0)"
"((temp86_0)(state-first-half state_0))" "((temp89_0)(state-first-half state_0))"
"((temp87_0)(cons 0 pos_0)))" "((temp90_0)(cons 0 pos_0)))"
"(finish25.1 temp87_0 temp83_0 temp84_0 s85_0 temp86_0))))" "(finish26.1 temp90_0 temp86_0 temp87_0 s88_0 temp89_0))))"
"(let-values(((i_0)" "(let-values(((i_0)"
"(let-values(((sgn/z88_0) sgn/z_0)" "(let-values(((sgn/z91_0) sgn/z_0)"
"((n89_0) n_0)" "((n92_0) n_0)"
"((s90_0) s_0)" "((s93_0) s_0)"
"((temp91_0)(state-second-half state_0))" "((temp94_0)(state-second-half state_0))"
"((temp92_0)(cons pos_0(string-length s_0))))" "((temp95_0)(cons pos_0(string-length s_0))))"
"(finish25.1 temp92_0 sgn/z88_0 n89_0 s90_0 temp91_0))))" "(finish26.1 temp95_0 sgn/z91_0 n92_0 s93_0 temp94_0))))"
"(if(extflonum? r_0)" "(if(extflonum? r_0)"
"(let-values()(bad-extflonum-for-complex r_0 s_0 state_0))" "(let-values()(bad-extflonum-for-complex r_0 s_0 state_0))"
"(if(extflonum? i_0)" "(if(extflonum? i_0)"
@ -54551,13 +54618,13 @@ static const char *startup_source =
" v_0))))))))))" " v_0))))))))))"
" (let-values () (bad-misplaced \"i\" s_0 state_0))))))))" " (let-values () (bad-misplaced \"i\" s_0 state_0))))))))"
"(define-values" "(define-values"
"(set-exactness32.1)" "(set-exactness33.1)"
"(lambda(override?28_0 state30_0 new-exactness31_0)" "(lambda(override?29_0 state31_0 new-exactness32_0)"
"(begin" "(begin"
" 'set-exactness32" " 'set-exactness33"
"(let-values(((state_0) state30_0))" "(let-values(((state_0) state31_0))"
"(let-values(((new-exactness_0) new-exactness31_0))" "(let-values(((new-exactness_0) new-exactness32_0))"
"(let-values(((override?_0) override?28_0))" "(let-values(((override?_0) override?29_0))"
"(let-values()" "(let-values()"
"(let-values(((exactness_0)(parse-state-exactness state_0)))" "(let-values(((exactness_0)(parse-state-exactness state_0)))"
"(let-values(((result-exactness_0)" "(let-values(((result-exactness_0)"
@ -54591,24 +54658,25 @@ static const char *startup_source =
" state_0" " state_0"
"(let-values(((the-struct_0) state_0))" "(let-values(((the-struct_0) state_0))"
"(if(parse-state? the-struct_0)" "(if(parse-state? the-struct_0)"
"(let-values(((exactness93_0) result-exactness_0))" "(let-values(((exactness96_0) result-exactness_0))"
"(parse-state7.1" "(parse-state8.1"
" exactness93_0" " exactness96_0"
"(parse-state-convert-mode the-struct_0)" "(parse-state-convert-mode the-struct_0)"
"(parse-state-can-single? the-struct_0)"
"(parse-state-fst the-struct_0)" "(parse-state-fst the-struct_0)"
"(parse-state-other-exactness the-struct_0)))" "(parse-state-other-exactness the-struct_0)))"
" (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0)))))))))))))" " (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0)))))))))))))"
"(define-values" "(define-values"
"(set-exactness-by-char39.1)" "(set-exactness-by-char40.1)"
"(lambda(override?35_0 state37_0 c38_0)" "(lambda(override?36_0 state38_0 c39_0)"
"(begin" "(begin"
" 'set-exactness-by-char39" " 'set-exactness-by-char40"
"(let-values(((state_0) state37_0))" "(let-values(((state_0) state38_0))"
"(let-values(((c_0) c38_0))" "(let-values(((c_0) c39_0))"
"(let-values(((override?_0) override?35_0))" "(let-values(((override?_0) override?36_0))"
"(let-values()" "(let-values()"
"(let-values(((state94_0) state_0)" "(let-values(((state97_0) state_0)"
"((temp95_0)" "((temp98_0)"
"(let-values(((tmp_0) c_0))" "(let-values(((tmp_0) c_0))"
"(let-values(((index_0)" "(let-values(((index_0)"
"(if(char? tmp_0)" "(if(char? tmp_0)"
@ -54692,8 +54760,8 @@ static const char *startup_source =
"(if(unsafe-fx< index_0 2)" "(if(unsafe-fx< index_0 2)"
"(let-values() 'double)" "(let-values() 'double)"
"(if(unsafe-fx< index_0 3)(let-values() 'single)(let-values() 'extended)))))))" "(if(unsafe-fx< index_0 3)(let-values() 'single)(let-values() 'extended)))))))"
"((override?96_0) override?_0))" "((override?99_0) override?_0))"
"(set-exactness32.1 override?96_0 state94_0 temp95_0)))))))))" "(set-exactness33.1 override?99_0 state97_0 temp98_0)))))))))"
"(define-values" "(define-values"
"(trim-number)" "(trim-number)"
"(lambda(s_0 start_0 end_0)" "(lambda(s_0 start_0 end_0)"
@ -54705,17 +54773,18 @@ static const char *startup_source =
"(let-values()(trim-number s_0 start_0(fx- end_0 1)))" "(let-values()(trim-number s_0 start_0(fx- end_0 1)))"
"(let-values()(substring s_0 start_0 end_0)))))))" "(let-values()(substring s_0 start_0 end_0)))))))"
"(define-values" "(define-values"
"(do-string->number50.1)" "(do-string->number52.1)"
"(lambda(radix-set?42_0 s44_0 start45_0 end46_0 radix47_0 exactness48_0 convert-mode49_0)" "(lambda(radix-set?43_0 s45_0 start46_0 end47_0 radix48_0 exactness49_0 convert-mode50_0 single-mode51_0)"
"(begin" "(begin"
" 'do-string->number50" " 'do-string->number52"
"(let-values(((s_0) s44_0))" "(let-values(((s_0) s45_0))"
"(let-values(((start_0) start45_0))" "(let-values(((start_0) start46_0))"
"(let-values(((end_0) end46_0))" "(let-values(((end_0) end47_0))"
"(let-values(((radix_0) radix47_0))" "(let-values(((radix_0) radix48_0))"
"(let-values(((radix-set?_0) radix-set?42_0))" "(let-values(((radix-set?_0) radix-set?43_0))"
"(let-values(((exactness_0) exactness48_0))" "(let-values(((exactness_0) exactness49_0))"
"(let-values(((convert-mode_0) convert-mode49_0))" "(let-values(((convert-mode_0) convert-mode50_0))"
"(let-values(((single-mode_0) single-mode51_0))"
"(let-values()" "(let-values()"
"(let-values(((c_0)" "(let-values(((c_0)"
"(if(fx= start_0 end_0)" "(if(fx= start_0 end_0)"
@ -54724,7 +54793,7 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(if(eq?(state->convert-mode convert-mode_0) 'must-read)"
" (let-values () (format \"no digits\"))" " (let-values () (format \"no digits\"))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
@ -54735,18 +54804,19 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(init-state exactness_0 convert-mode_0 #f)))" "(init-state exactness_0 convert-mode_0 single-mode_0 #f)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((next_0)(fx+ 1 start_0)))" "(let-values(((next_0)(fx+ 1 start_0)))"
"(let-values(((i_0)" "(let-values(((i_0)"
"(if(fx= next_0 end_0)" "(if(fx= next_0 end_0)"
" 'eof" " 'eof"
"(let-values(((c_1)(string-ref s_0 next_0)))(maybe-digit c_1 10)))))" "(let-values(((c_1)(string-ref s_0 next_0)))"
"(maybe-digit c_1 10)))))"
"(if(let-values(((or-part_0)(eqv? i_0 'eof)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? i_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(if(eq?(state->convert-mode convert-mode_0) 'must-read)"
" (let-values () (format \"no character after `#` indicator in `~.a`\" s_0))" " (let-values () (format \"no character after `#` indicator in `~.a`\" s_0))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(let-values(((or-part_0)(eqv? i_0 '#\\e)))" "(if(let-values(((or-part_0)(eqv? i_0 '#\\e)))"
"(if or-part_0" "(if or-part_0"
@ -54766,30 +54836,32 @@ static const char *startup_source =
"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(if(eq?(state->convert-mode convert-mode_0) 'must-read)"
"(let-values()" "(let-values()"
"(format" "(format"
" \"misplaced exactness specification at `~.a`\"" " \"misplaced exactness specification at `~.a`\""
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(let-values(((s97_0) s_0)" "(let-values(((s100_0) s_0)"
"((temp98_0)(fx+ 1 next_0))" "((temp101_0)(fx+ 1 next_0))"
"((end99_0) end_0)" "((end102_0) end_0)"
"((radix100_0) radix_0)" "((radix103_0) radix_0)"
"((radix-set?101_0) radix-set?_0)" "((radix-set?104_0) radix-set?_0)"
"((temp102_0)" "((temp105_0)"
"(if(let-values(((or-part_0)(char=? i_0 '#\\e)))" "(if(let-values(((or-part_0)(char=? i_0 '#\\e)))"
"(if or-part_0 or-part_0(char=? i_0 '#\\E)))" "(if or-part_0 or-part_0(char=? i_0 '#\\E)))"
" 'exact" " 'exact"
" 'inexact))" " 'inexact))"
"((temp103_0)" "((temp106_0)"
"(if(eq? convert-mode_0 'read) 'must-read convert-mode_0)))" "(if(eq? convert-mode_0 'read) 'must-read convert-mode_0))"
"(do-string->number50.1" "((single-mode107_0) single-mode_0))"
" radix-set?101_0" "(do-string->number52.1"
" s97_0" " radix-set?104_0"
" temp98_0" " s100_0"
" end99_0" " temp101_0"
" radix100_0" " end102_0"
" temp102_0" " radix103_0"
" temp103_0)))))" " temp105_0"
" temp106_0"
" single-mode107_0)))))"
"(if(let-values(((or-part_0)(eqv? i_0 '#\\b)))" "(if(let-values(((or-part_0)(eqv? i_0 '#\\b)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -54819,7 +54891,7 @@ static const char *startup_source =
"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(if(eq?(state->convert-mode convert-mode_0) 'must-read)"
"(let-values()" "(let-values()"
"(format" "(format"
" \"misplaced radix specification at `~.a`\"" " \"misplaced radix specification at `~.a`\""
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
@ -54829,27 +54901,31 @@ static const char *startup_source =
"(let-values() 2)" "(let-values() 2)"
"(if(if(equal? tmp_0 '#\\o) #t(equal? tmp_0 '#\\O))" "(if(if(equal? tmp_0 '#\\o) #t(equal? tmp_0 '#\\O))"
"(let-values() 8)" "(let-values() 8)"
"(if(if(equal? tmp_0 '#\\d) #t(equal? tmp_0 '#\\D))" "(if(if(equal? tmp_0 '#\\d)"
" #t"
"(equal? tmp_0 '#\\D))"
"(let-values() 10)" "(let-values() 10)"
"(let-values() 16)))))))" "(let-values() 16)))))))"
"(let-values(((s104_0) s_0)" "(let-values(((s108_0) s_0)"
"((temp105_0)(fx+ 1 next_0))" "((temp109_0)(fx+ 1 next_0))"
"((end106_0) end_0)" "((end110_0) end_0)"
"((radix107_0) radix_1)" "((radix111_0) radix_1)"
"((temp108_0) #t)" "((temp112_0) #t)"
"((exactness109_0) exactness_0)" "((exactness113_0) exactness_0)"
"((temp110_0)" "((temp114_0)"
"(if(eq? convert-mode_0 'read)" "(if(eq? convert-mode_0 'read)"
" 'must-read" " 'must-read"
" convert-mode_0)))" " convert-mode_0))"
"(do-string->number50.1" "((single-mode115_0) single-mode_0))"
" temp108_0" "(do-string->number52.1"
" s104_0" " temp112_0"
" temp105_0" " s108_0"
" end106_0" " temp109_0"
" radix107_0" " end110_0"
" exactness109_0" " radix111_0"
" temp110_0))))))" " exactness113_0"
" temp114_0"
" single-mode115_0))))))"
"(let-values()" "(let-values()"
"(if(eq?" "(if(eq?"
"(state->convert-mode" "(state->convert-mode"
@ -54857,7 +54933,7 @@ static const char *startup_source =
" 'must-read)" " 'must-read)"
"(let-values()" "(let-values()"
"(format" "(format"
" \"bad `#` indicator `~a` at `~.a`\"" " \"bad `#` indicator `~a` at `~.a`\""
" i_0" " i_0"
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))))))))" "(let-values() #f)))))))))"
@ -54869,7 +54945,7 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(init-state exactness_0 convert-mode_0 '+/-)))" "(init-state exactness_0 convert-mode_0 single-mode_0 '+/-)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\-)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\-)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(read-signed" "(read-signed"
@ -54878,7 +54954,7 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(init-state exactness_0 convert-mode_0 '+/-)))" "(init-state exactness_0 convert-mode_0 single-mode_0 '+/-)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(read-decimal" "(read-decimal"
@ -54889,10 +54965,11 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((temp111_0)(init-state exactness_0 convert-mode_0 #f))" "(let-values(((temp116_0)"
"((temp112_0) 'approx))" "(init-state exactness_0 convert-mode_0 single-mode_0 #f))"
"(set-exactness32.1 #f temp111_0 temp112_0))))" "((temp117_0) 'approx))"
"(let-values()(bad-digit c_0 s_0 convert-mode_0))))))))))))))))))))" "(set-exactness33.1 #f temp116_0 temp117_0))))"
"(let-values()(bad-digit c_0 s_0 convert-mode_0)))))))))))))))))))))"
"(define-values" "(define-values"
"(read-signed)" "(read-signed)"
"(lambda(sgn_0 s_0 start_0 end_0 radix_0 state_0)" "(lambda(sgn_0 s_0 start_0 end_0 radix_0 state_0)"
@ -54918,8 +54995,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state113_0) state_0)((temp114_0) 'approx))" "(let-values(((state118_0) state_0)((temp119_0) 'approx))"
"(set-exactness32.1 #f state113_0 temp114_0))))" "(set-exactness33.1 #f state118_0 temp119_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))" "(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
@ -54950,8 +55027,8 @@ static const char *startup_source =
"(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))" "(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))"
"(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((sgn115_0) sgn_0)((temp116_0)(get-n_0))((s117_0) s_0)((state118_0) state_0))" "(let-values(((sgn120_0) sgn_0)((temp121_0)(get-n_0))((s122_0) s_0)((state123_0) state_0))"
"(finish25.1 #f sgn115_0 temp116_0 s117_0 state118_0)))" "(finish26.1 #f sgn120_0 temp121_0 s122_0 state123_0)))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-integer sgn_0(+(* n_0 radix_0) c_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(let-values()(read-integer sgn_0(+(* n_0 radix_0) c_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))"
@ -54964,8 +55041,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state119_0) state_0)((temp120_0) 'approx))" "(let-values(((state124_0) state_0)((temp125_0) 'approx))"
"(set-exactness32.1 #f state119_0 temp120_0))))" "(set-exactness33.1 #f state124_0 temp125_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -55010,8 +55087,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state121_0) state_0)((c122_0) c_0))" "(let-values(((state126_0) state_0)((c127_0) c_0))"
"(set-exactness-by-char39.1 #f state121_0 c122_0))))" "(set-exactness-by-char40.1 #f state126_0 c127_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-rational sgn_0(get-n_0) #f s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(let-values()(read-rational sgn_0(get-n_0) #f s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))"
@ -55025,8 +55102,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state123_0) state_0)((temp124_0) 'approx))" "(let-values(((state128_0) state_0)((temp129_0) 'approx))"
"(set-exactness32.1 #f state123_0 temp124_0))))" "(set-exactness33.1 #f state128_0 temp129_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -55072,8 +55149,8 @@ static const char *startup_source =
"(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))" "(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))"
" v_0" " v_0"
"((lambda(n_1)" "((lambda(n_1)"
"(let-values(((sgn125_0) sgn_0)((n126_0) n_1)((s127_0) s_0)((state128_0) state_0))" "(let-values(((sgn130_0) sgn_0)((n131_0) n_1)((s132_0) s_0)((state133_0) state_0))"
"(finish25.1 #f sgn125_0 n126_0 s127_0 state128_0)))" "(finish26.1 #f sgn130_0 n131_0 s132_0 state133_0)))"
" v_0))))))" " v_0))))))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
@ -55146,8 +55223,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state129_0) state_0)((c130_0) c_0))" "(let-values(((state134_0) state_0)((c135_0) c_0))"
"(set-exactness-by-char39.1 #f state129_0 c130_0)))" "(set-exactness-by-char40.1 #f state134_0 c135_0)))"
" (bad-no-digits \".\" s_0 state_0)))" " (bad-no-digits \".\" s_0 state_0)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))"
"(let-values()(bad-mixed-decimal-fraction s_0 state_0))" "(let-values()(bad-mixed-decimal-fraction s_0 state_0))"
@ -55200,8 +55277,8 @@ static const char *startup_source =
"(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))" "(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))"
"(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((sgn131_0) sgn_0)((temp132_0)(get-n_0))((s133_0) s_0)((state134_0) state_0))" "(let-values(((sgn136_0) sgn_0)((temp137_0)(get-n_0))((s138_0) s_0)((state139_0) state_0))"
"(finish25.1 #f sgn131_0 temp132_0 s133_0 state134_0)))" "(finish26.1 #f sgn136_0 temp137_0 s138_0 state139_0)))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
" (let-values () (bad-misplaced \"#\" s_0 state_0))" " (let-values () (bad-misplaced \"#\" s_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))"
@ -55265,8 +55342,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state135_0) state_0)((c136_0) c_0))" "(let-values(((state140_0) state_0)((c141_0) c_0))"
"(set-exactness-by-char39.1 #f state135_0 c136_0))))" "(set-exactness-by-char40.1 #f state140_0 c141_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(if saw-.?_0" "(if saw-.?_0"
@ -55403,8 +55480,8 @@ static const char *startup_source =
"(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))" "(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))"
" v_0" " v_0"
"((lambda(n_0)" "((lambda(n_0)"
"(let-values(((sgn137_0) sgn_0)((n138_0) n_0)((s139_0) s_0)((state140_0) state_0))" "(let-values(((sgn142_0) sgn_0)((n143_0) n_0)((s144_0) s_0)((state145_0) state_0))"
"(finish25.1 #f sgn137_0 n138_0 s139_0 state140_0)))" "(finish26.1 #f sgn142_0 n143_0 s144_0 state145_0)))"
" v_0))))))" " v_0))))))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
@ -55523,13 +55600,13 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))" "(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))"
"(let-values(((new-state_0)" "(let-values(((new-state_0)"
"(let-values(((state141_0) state_0)" "(let-values(((state146_0) state_0)"
"((temp142_0)(string-ref s_0(fx+ start_0 2)))" "((temp147_0)(string-ref s_0(fx+ start_0 2)))"
"((temp143_0) #t))" "((temp148_0) #t))"
"(set-exactness-by-char39.1" "(set-exactness-by-char40.1"
" temp143_0" " temp148_0"
" state141_0" " state146_0"
" temp142_0))))" " temp147_0))))"
"(let-values(((c2_0)" "(let-values(((c2_0)"
"(if(fx=(fx+ 3 start_0) end_0)" "(if(fx=(fx+ 3 start_0) end_0)"
" 'eof" " 'eof"
@ -55538,11 +55615,11 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(eqv? c2_0 'eof)))" "(if(let-values(((or-part_0)(eqv? c2_0 'eof)))"
"(if or-part_0 or-part_0 #f))" "(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((sgn144_0) sgn_0)" "(let-values(((sgn149_0) sgn_0)"
"((n145_0) n_0)" "((n150_0) n_0)"
"((s146_0) s_0)" "((s151_0) s_0)"
"((new-state147_0) new-state_0))" "((new-state152_0) new-state_0))"
"(finish25.1 #f sgn144_0 n145_0 s146_0 new-state147_0)))" "(finish26.1 #f sgn149_0 n150_0 s151_0 new-state152_0)))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))" "(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -55625,14 +55702,14 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(let-values(((n_0) +nan.0))" "(let-values(((n_0) +nan.0))"
"(let-values(((new-state_0)" "(let-values(((new-state_0)"
"(let-values(((state148_0) state_0)" "(let-values(((state153_0) state_0)"
"((temp149_0)" "((temp154_0)"
"(string-ref s_0(fx+ start_0 3)))" "(string-ref s_0(fx+ start_0 3)))"
"((temp150_0) #t))" "((temp155_0) #t))"
"(set-exactness-by-char39.1" "(set-exactness-by-char40.1"
" temp150_0" " temp155_0"
" state148_0" " state153_0"
" temp149_0))))" " temp154_0))))"
"(let-values(((c2_0)" "(let-values(((c2_0)"
"(if(fx=(fx+ 4 start_0) end_0)" "(if(fx=(fx+ 4 start_0) end_0)"
" 'eof" " 'eof"
@ -55644,16 +55721,16 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(eqv? c2_0 'eof)))" "(if(let-values(((or-part_0)(eqv? c2_0 'eof)))"
"(if or-part_0 or-part_0 #f))" "(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((temp151_0) 1)" "(let-values(((temp156_0) 1)"
"((n152_0) n_0)" "((n157_0) n_0)"
"((s153_0) s_0)" "((s158_0) s_0)"
"((new-state154_0) new-state_0))" "((new-state159_0) new-state_0))"
"(finish25.1" "(finish26.1"
" #f" " #f"
" temp151_0" " temp156_0"
" n152_0" " n157_0"
" s153_0" " s158_0"
" new-state154_0)))" " new-state159_0)))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))" "(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -55717,8 +55794,8 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(n_0)" "((lambda(n_0)"
"(let-values(((sgn155_0) sgn_0)((n156_0) n_0)((s157_0) s_0)((state158_0) state_0))" "(let-values(((sgn160_0) sgn_0)((n161_0) n_0)((s162_0) s_0)((state163_0) state_0))"
"(finish25.1 #f sgn155_0 n156_0 s157_0 state158_0)))" "(finish26.1 #f sgn160_0 n161_0 s162_0 state163_0)))"
" v_0))))" " v_0))))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
@ -55745,8 +55822,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state159_0) state_0)((temp160_0) 'approx))" "(let-values(((state164_0) state_0)((temp165_0) 'approx))"
"(set-exactness32.1 #f state159_0 temp160_0)))" "(set-exactness33.1 #f state164_0 temp165_0)))"
" (bad-misplaced \"#\" s_0 state_0)))" " (bad-misplaced \"#\" s_0 state_0)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))"
"(if or-part_0" "(if or-part_0"
@ -55796,8 +55873,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state161_0) state_0)((c162_0) c_0))" "(let-values(((state166_0) state_0)((c167_0) c_0))"
"(set-exactness-by-char39.1 #f state161_0 c162_0))))" "(set-exactness-by-char40.1 #f state166_0 c167_0))))"
" v_0))))" " v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))"
" (let-values () (bad-misplaced \"/\" s_0 state_0))" " (let-values () (bad-misplaced \"/\" s_0 state_0))"
@ -55848,8 +55925,8 @@ static const char *startup_source =
"(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))" "(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))"
"(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((sgn163_0) sgn_0)((temp164_0)(get-n_0))((s165_0) s_0)((state166_0) state_0))" "(let-values(((sgn168_0) sgn_0)((temp169_0)(get-n_0))((s170_0) s_0)((state171_0) state_0))"
"(finish25.1 #f sgn163_0 temp164_0 s165_0 state166_0)))" "(finish26.1 #f sgn168_0 temp169_0 s170_0 state171_0)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(read-denom-approx sgn_0 sgn-n_0 d_0(fx+ 1 exp_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(read-denom-approx sgn_0 sgn-n_0 d_0(fx+ 1 exp_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
@ -55902,8 +55979,8 @@ static const char *startup_source =
"(fx+ 1 start_0)" "(fx+ 1 start_0)"
" end_0" " end_0"
" radix_0" " radix_0"
"(let-values(((state167_0) state_0)((c168_0) c_0))" "(let-values(((state172_0) state_0)((c173_0) c_0))"
"(set-exactness-by-char39.1 #f state167_0 c168_0))))" "(set-exactness-by-char40.1 #f state172_0 c173_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -55941,7 +56018,7 @@ static const char *startup_source =
" start_0" " start_0"
" end_0" " end_0"
" radix_0" " radix_0"
"(state-set-first-half state_0(rect-prefix8.1 real-sgn_0 real_0(fx- start_0 1)))))))))" "(state-set-first-half state_0(rect-prefix9.1 real-sgn_0 real_0(fx- start_0 1)))))))))"
"(define-values" "(define-values"
"(read-polar)" "(read-polar)"
"(lambda(real-sgn_0 real_0 s_0 start_0 end_0 radix_0 state_0)" "(lambda(real-sgn_0 real_0 s_0 start_0 end_0 radix_0 state_0)"
@ -55960,12 +56037,12 @@ static const char *startup_source =
"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" "(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(let-values(((new-state_0)" "(let-values(((new-state_0)"
"(state-set-first-half state_0(polar-prefix9.1 real-sgn_0 real_0 start_0))))" "(state-set-first-half state_0(polar-prefix10.1 real-sgn_0 real_0 start_0))))"
"(read-signed(if(eq? c_0 '#\\+) 1 -1) s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))" "(read-signed(if(eq? c_0 '#\\+) 1 -1) s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()" "(let-values()"
"(let-values(((new-state_0)" "(let-values(((new-state_0)"
"(state-set-first-half state_0(polar-prefix9.1 real-sgn_0 real_0 start_0))))" "(state-set-first-half state_0(polar-prefix10.1 real-sgn_0 real_0 start_0))))"
"(read-integer 1 c_0 s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))" "(read-integer 1 c_0 s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))"
"(let-values()(bad-digit c_0 s_0 state_0)))))))))))" "(let-values()(bad-digit c_0 s_0 state_0)))))))))))"
"(define-values" "(define-values"
@ -56269,7 +56346,10 @@ static const char *startup_source =
" 1/read-decimal-as-inexact" " 1/read-decimal-as-inexact"
" config_0)" " config_0)"
" 'decimal-as-inexact" " 'decimal-as-inexact"
" 'decimal-as-exact))" " 'decimal-as-exact)"
"(if(check-parameter 1/read-single-flonum config_0)"
" 'single"
" 'double))"
" #f)" " #f)"
" #f)))" " #f)))"
"(begin" "(begin"
@ -64026,6 +64106,8 @@ static const char *startup_source =
" 1/read-accept-box" " 1/read-accept-box"
" 'read-decimal-as-inexact" " 'read-decimal-as-inexact"
" 1/read-decimal-as-inexact" " 1/read-decimal-as-inexact"
" 'read-single-flonum"
" 1/read-single-flonum"
" 'read-accept-dot" " 'read-accept-dot"
" 1/read-accept-dot" " 1/read-accept-dot"
" 'read-accept-infix-dot" " 'read-accept-infix-dot"

3
racket/src/schemify/schemify.rkt
View File

@ -620,6 +620,9 @@
(list (schemify generator) (schemify receiver)) (list (schemify generator) (schemify receiver))
#t for-cify? #t for-cify?
prim-knowns knowns imports mutated simples)])] prim-knowns knowns imports mutated simples)])]
[`(single-flonum-available?)
;; Fold to a boolean to allow earlier simplification
for-cify?]
[`((letrec-values ,binds ,rator) ,rands ...) [`((letrec-values ,binds ,rator) ,rands ...)
(schemify `(letrec-values ,binds (,rator . ,rands)))] (schemify `(letrec-values ,binds (,rator . ,rands)))]
[`(,rator ,exps ...) [`(,rator ,exps ...)