print-boolean-long-form, #true, #false, read-accept-lang, flonum?

This commit is contained in:
Matthew Flatt 2010-10-08 15:11:17 -06:00
parent 0eed02bd0d
commit fe301b1ff4
30 changed files with 1259 additions and 992 deletions

View File

@ -433,6 +433,8 @@
(define show-inexactness? (pretty-print-show-inexactness))
(define exact-as-decimal? (pretty-print-exact-as-decimal))
(define long-bools? (print-boolean-long-form))
(define vector->repeatless-list
(if print-vec-length?
@ -912,7 +914,9 @@
[(hide? obj)
(wr* pport (hide-val obj) depth display? qd)]
[(boolean? obj)
(out (if obj "#t" "#f"))]
(out (if long-bools?
(if obj "#true" "#false")
(if obj "#t" "#f")))]
[(number? obj)
(when (and show-inexactness?
(inexact? obj))

View File

@ -47,14 +47,15 @@ continuation's frames to the marks that were present when
@racket[call-with-current-continuation] or
@racket[call-with-composable-continuation] was invoked.
@defproc[(continuation-marks [cont (or/c continuation? thread?)]
@defproc[(continuation-marks [cont (or/c continuation? thread? #f)]
[prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)])
continuation-mark-set?]{
Returns an opaque value containing the set of continuation marks for
all keys in the continuation @racket[cont] (or the current
continuation of @racket[cont] if it is a thread) up to the prompt
tagged by @racket[prompt-tag]. If @racket[cont] is an escape
tagged by @racket[prompt-tag]. If @racket[cont] is @racket[#f], the
resulting set of continuation marks is empty. If @racket[cont] is an escape
continuation (see @secref["prompt-model"]), then the current
continuation must extend @racket[cont], or the
@exnraise[exn:fail:contract]. If @racket[cont] was not captured with

View File

@ -92,8 +92,8 @@ contain a module declaration), or @racket[#f] for any other load.
The default load handler reads forms from the file in
@racket[read-syntax] mode with line-counting enabled for the file
port, unless the path has a @racket[".zo"] suffix. It also
@racket[parameterize]s each read to set both
@racket[read-accept-compiled] and @racket[read-accept-reader] to
@racket[parameterize]s each read to set @racket[read-accept-compiled],
@racket[read-accept-reader], and @racket[read-accept-lang] to
@racket[#t]. In addition, if @racket[load-on-demand-enabled] is
@racket[#t], then @racket[read-on-demand-source] is effectively set to
the @tech{cleanse}d, absolute form of @racket[path] during the
@ -126,6 +126,7 @@ If the second argument to the load handler is a symbol, then:
(read-accept-infix-dot #t)
(read-accept-quasiquote #t)
(read-accept-reader #t)
(read-accept-lang #t)
]}
@item{If the read result is not a @racketidfont{module} form, or if a

View File

@ -0,0 +1,193 @@
#lang scribble/doc
@(require "mz.ss"
racket/math
scribble/extract
(for-label racket/math
racket/flonum
racket/fixnum
racket/unsafe/ops
racket/require))
@(define flfx-eval (make-base-eval))
@(interaction-eval #:eval flfx-eval (require racket/fixnum))
@title[#:tag "fixnums"]{Fixnums}
@defmodule[racket/fixnum]
The @racketmodname[racket/fixnum] library provides operations like
@racket[fx+] that consume and produce only fixnums. The operations in
this library are meant to be safe versions of unsafe operations like
@racket[unsafe-fx+]. These safe operations are generally no faster
than using generic primitives like @racket[+].
The expected use of the @racketmodname[racket/fixnum] library is for
code where the @racket[require] of @racketmodname[racket/fixnum] is
replaced with
@racketblock[(require (filtered-in
(λ (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))]
to drop in unsafe versions of the library. Alternately, when
encountering crashes with code that uses unsafe fixnum operations, use
the @racketmodname[racket/fixnum] library to help debug the problems.
@; ------------------------------------------------------------
@section{Fixnum Arithmetic}
@deftogether[(
@defproc[(fx+ [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fx- [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fx* [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxquotient [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxremainder [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxmodulo [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxabs [a fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx+], @racket[unsafe-fx-],
@racket[unsafe-fx*], @racket[unsafe-fxquotient],
@racket[unsafe-fxremainder], @racket[unsafe-fxmodulo], and
@racket[unsafe-fxabs]. The
@exnraise[exn:fail:contract:non-fixnum-result] if the arithmetic
result would not be a fixnum.}
@deftogether[(
@defproc[(fxand [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxior [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxxor [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxnot [a fixnum?]) fixnum?]
@defproc[(fxlshift [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxrshift [a fixnum?] [b fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fxand], @racket[unsafe-fxior],
@racket[unsafe-fxxor], @racket[unsafe-fxnot],
@racket[unsafe-fxlshift], and @racket[unsafe-fxrshift]. The
@exnraise[exn:fail:contract:non-fixnum-result] if the arithmetic
result would not be a fixnum.}
@deftogether[(
@defproc[(fx= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx< [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx> [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx<= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx>= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fxmin [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxmax [a fixnum?] [b fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<],
@racket[unsafe-fx>], @racket[unsafe-fx<=], @racket[unsafe-fx>=],
@racket[unsafe-fxmin], and @racket[unsafe-fxmax].}
@deftogether[(
@defproc[(fx->fl [a fixnum?]) flonum?]
@defproc[(fl->fx [a flonum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx->fl] and @racket[unsafe-fl->fx].}
@; ------------------------------------------------------------
@section{Fixnum Vectors}
A @deftech{fxvector} is like a @tech{vector}, but it holds only
@tech{fixnums}. The only advantage of an @tech{fxvector} over a
@tech{vector} is that a shared version can be created with functions
like @racket[shared-fxvector].
Two @tech{fxvectors} are @racket[equal?] if they have the same length,
and if the values in corresponding slots of the @tech{fxvectors} are
@racket[equal?].
@defproc[(fxvector? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{fxvector}, @racket[#f] otherwise.}
@defproc[(fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
@mz-examples[#:eval flfx-eval (fxvector 2 3 4 5)]}
@defproc[(make-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
@mz-examples[#:eval flfx-eval (make-fxvector 4 3)]}
@defproc[(fxvector-length [vec fxvector?]) exact-nonnegative-integer?]{
Returns the length of @racket[vec] (i.e., the number of slots in the
@tech{fxvector}).}
@defproc[(fxvector-ref [vec fxvector?] [pos exact-nonnegative-integer?])
fixnum?]{
Returns the @tech{fixnum} in slot @racket[pos] of
@racket[vec]. The first slot is position @racket[0], and the last slot
is one less than @racket[(fxvector-length vec)].}
@defproc[(fxvector-set! [vec fxvector?] [pos exact-nonnegative-integer?]
[x fixnum?])
fixnum?]{
Sets the @tech{fixnum} in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(fxvector-length vec)].}
@defproc[(fxvector-copy [vec fxvector?]
[start exact-nonnegative-integer? 0]
[end exact-nonnegative-integer? (vector-length v)])
fxvector?]{
Creates a fresh @tech{fxvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).}
@defproc[(in-fxvector (v fxvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
elements of @scheme[v] efficiently as in @scheme[in-list],
@scheme[in-vector], etc.}
@deftogether[(
@defform*[((for/fxvector (for-clause ...) body ...)
(for/fxvector #:length length-expr (for-clause ...) body ...))]
@defform*[((for*/fxvector (for-clause ...) body ...)
(for*/fxvector #:length length-expr (for-clause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{fxvector}s.}
@defproc[(shared-fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (shared-fxvector 2 3 4 5)]}
@defproc[(make-shared-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (make-shared-fxvector 4 3)]}

View File

@ -0,0 +1,212 @@
#lang scribble/doc
@(require "mz.ss"
(for-label racket/flonum))
@(define fl-eval (make-base-eval))
@(interaction-eval #:eval fl-eval (require racket/flonum))
@title[#:tag "flonums"]{Flonums}
@defmodule[racket/flonum]
The @racketmodname[racket/flonum] library provides operations like
@racket[fl+] that consume and produce only
@tech{flonums}. Flonum-specific operations provide can better
performance when used consistently, and they are as safe as generic
operations like @racket[+].
@guidealso["fixnums+flonums"]
@; ------------------------------------------------------------------------
@section{Flonum Arithmetic}
@deftogether[(
@defproc[(fl+ [a flonum?] [b flonum?]) flonum?]
@defproc[(fl- [a flonum?] [b flonum?]) flonum?]
@defproc[(fl* [a flonum?] [b flonum?]) flonum?]
@defproc[(fl/ [a flonum?] [b flonum?]) flonum?]
@defproc[(flabs [a flonum?]) flonum?]
)]{
Like @racket[+], @racket[-], @racket[*], @racket[/], and @racket[abs],
but constrained to consume @tech{flonums}. The result is always a
@tech{flonum}.}
@deftogether[(
@defproc[(fl= [a flonum?] [b flonum?]) boolean?]
@defproc[(fl< [a flonum?] [b flonum?]) boolean?]
@defproc[(fl> [a flonum?] [b flonum?]) boolean?]
@defproc[(fl<= [a flonum?] [b flonum?]) boolean?]
@defproc[(fl>= [a flonum?] [b flonum?]) boolean?]
@defproc[(flmin [a flonum?] [b flonum?]) flonum?]
@defproc[(flmax [a flonum?] [b flonum?]) flonum?]
)]{
Like @racket[=], @racket[<], @racket[>], @racket[<=], @racket[>=],
@racket[min], and @racket[max], but constrained to consume
@tech{flonums}.}
@deftogether[(
@defproc[(flround [a flonum?]) flonum?]
@defproc[(flfloor [a flonum?]) flonum?]
@defproc[(flceiling [a flonum?]) flonum?]
@defproc[(fltruncate [a flonum?]) flonum?]
)]{
Like @racket[round], @racket[floor], @racket[ceiling], and
@racket[truncate], but constrained to consume @tech{flonums}.}
@deftogether[(
@defproc[(flsin [a flonum?]) flonum?]
@defproc[(flcos [a flonum?]) flonum?]
@defproc[(fltan [a flonum?]) flonum?]
@defproc[(flasin [a flonum?]) flonum?]
@defproc[(flacos [a flonum?]) flonum?]
@defproc[(flatan [a flonum?]) flonum?]
@defproc[(fllog [a flonum?]) flonum?]
@defproc[(flexp [a flonum?]) flonum?]
@defproc[(flsqrt [a flonum?]) flonum?]
)]{
Like @racket[sin], @racket[cos], @racket[tan], @racket[asin],
@racket[acos], @racket[atan], @racket[log], @racket[exp], and
@racket[flsqrt], but constrained to consume and produce
@tech{flonums}. The result is @racket[+nan.0] when a number outside
the range @racket[-1.0] to @racket[1.0] is given to @racket[flasin] or
@racket[flacos], or when a negative number is given to @racket[fllog]
or @racket[flsqrt].}
@defproc[(->fl [a exact-integer?]) flonum?]{
Like @racket[exact->inexact], but constrained to consume exact
integers, so the result is always a @tech{flonum}.}
@defproc[(fl->exact-integer [a flonum?]) exact-integer?]{
Like @racket[inexact->exact], but constrained to consume an
@tech{integer} @tech{flonum}, so the result is always an exact
integer.}
@deftogether[(
@defproc[(make-flrectangular [a flonum?] [b flonum?])
(and/c complex? inexact? (not/c real?))]
@defproc[(flreal-part [a (and/c complex? inexact? (not/c real?))]) flonum?]
@defproc[(flimag-part [a (and/c complex? inexact? (not/c real?))]) flonum?]
)]{
Like @racket[make-rectangular], @racket[real-part], and
@racket[imag-part], but both parts of the complex number must be
inexact.}
@; ------------------------------------------------------------------------
@section{Flonum Vectors}
A @deftech{flvector} is like a @tech{vector}, but it holds only
inexact real numbers. This representation can be more compact, and
unsafe operations on @tech{flvector}s (see
@racketmodname[racket/unsafe/ops]) can execute more efficiently than
unsafe operations on @tech{vectors} of inexact reals.
An f64vector as provided by @racketmodname[ffi/vector] stores the
same kinds of values as an @tech{flvector}, but with extra
indirections that make f64vectors more convenient for working with
foreign libraries. The lack of indirections make unsafe
@tech{flvector} access more efficient.
Two @tech{flvectors} are @racket[equal?] if they have the same length,
and if the values in corresponding slots of the @tech{flvectors} are
@racket[equal?].
@defproc[(flvector? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{flvector}, @racket[#f] otherwise.}
@defproc[(flvector [x flonum?] ...) flvector?]{
Creates a @tech{flvector} containing the given inexact real numbers.
@mz-examples[#:eval fl-eval (flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-flvector [size exact-nonnegative-integer?]
[x flonum? 0.0])
flvector?]{
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
@mz-examples[#:eval fl-eval (make-flvector 4 3.0)]}
@defproc[(flvector-length [vec flvector?]) exact-nonnegative-integer?]{
Returns the length of @racket[vec] (i.e., the number of slots in the
@tech{flvector}).}
@defproc[(flvector-ref [vec flvector?] [pos exact-nonnegative-integer?])
flonum?]{
Returns the inexact real number in slot @racket[pos] of
@racket[vec]. The first slot is position @racket[0], and the last slot
is one less than @racket[(flvector-length vec)].}
@defproc[(flvector-set! [vec flvector?] [pos exact-nonnegative-integer?]
[x flonum?])
flonum?]{
Sets the inexact real number in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(flvector-length vec)].}
@defproc[(flvector-copy [vec flvector?]
[start exact-nonnegative-integer? 0]
[end exact-nonnegative-integer? (vector-length v)])
flvector?]{
Creates a fresh @tech{flvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).}
@defproc[(in-flvector (v flvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
elements of @scheme[v] efficiently as in @scheme[in-list],
@scheme[in-vector], etc.}
@deftogether[(
@defform*[((for/flvector (for-clause ...) body ...)
(for/flvector #:length length-expr (for-clause ...) body ...))]
@defform*[((for*/flvector (for-clause ...) body ...)
(for*/flvector #:length length-expr (for-clause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{flvector}s.}
@defproc[(shared-flvector [x flonum?] ...) flvector?]{
Creates a @tech{flvector} containing the given inexact real numbers.
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval fl-eval (shared-flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-shared-flvector [size exact-nonnegative-integer?]
[x flonum? 0.0])
flvector?]{
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval fl-eval (make-shared-flvector 4 3.0)]}
@; ------------------------------------------------------------
@close-eval[fl-eval]

View File

@ -11,11 +11,7 @@
@(define math-eval (make-base-eval))
@(interaction-eval #:eval math-eval (require racket/math))
@(define flfx-eval (make-base-eval))
@(interaction-eval #:eval flfx-eval (require racket/fixnum))
@(interaction-eval #:eval flfx-eval (require racket/flonum))
@title[#:tag "numbers"]{Numbers}
@title[#:tag "numbers" #:style '(toc)]{Numbers}
@guideintro["numbers"]{numbers}
@ -28,6 +24,9 @@ represented are also @deftech{rational numbers}, except for
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
syntax of number literals.}
Orthogonal to those categories, each number is also either an
@deftech{exact number} or an @deftech{inexact number}. Unless
otherwise specified, computations that involve an inexact number
@ -46,8 +45,9 @@ Inexact real numbers are implemented as either single- or
double-precision @as-index{IEEE floating-point numbers}---the latter
by default, and the former only when support for 32-bit inexact
numbers is specifically enabled when the run-time system is built, and
when computation starts with numerical constants specified as
single-precision numbers.
only when a computation starts with numerical constants specified as
single-precision numbers. Inexact real numbers that are represented as
double-precision floating-point numbers are @deftech{flonums}.
The precision and size of exact numbers is limited only by available
memory (and the precision of operations that can produce irrational
@ -85,8 +85,10 @@ exact, and when they are @racket[=] (except for @racket[+nan.0],
@racket[+0.0], and @racket[-0.0], as noted above). Two numbers are
@racket[equal?] when they are @racket[eqv?].
@local-table-of-contents[]
@; ----------------------------------------
@section{Number Types}
@section[#:tag "number-types"]{Number Types}
@defproc[(number? [v any/c]) boolean?]{Returns @racket[#t] if @racket[v]
is a number, @racket[#f] otherwise.
@ -150,6 +152,12 @@ Return @racket[#t] if @racket[v] is a @techlink{fixnum}, @racket[#f]
otherwise.}
@defproc[(flonum? [v any/c]) boolean?]{
Return @racket[#t] if @racket[v] is a @techlink{flonum}, @racket[#f]
otherwise.}
@defproc[(zero? [z number?]) boolean?]{ Returns @racket[(= 0 z)].
@mz-examples[(zero? 0) (zero? -0.0)]}
@ -201,9 +209,13 @@ otherwise.}
@mz-examples[(exact->inexact 1) (exact->inexact 1.0)]}
@; ----------------------------------------
@section[#:tag "generic-numbers"]{Generic Numerics}
Most Racket numeric operations work on any kind of number.
@; ----------------------------------------
@section{Arithmetic}
@subsection{Arithmetic}
@defproc[(+ [z number?] ...) number?]{
@ -412,7 +424,7 @@ Among the real numbers within @racket[(abs tolerance)] of @racket[x],
]}
@; ----------------------------------------
@section{Number Comparison}
@subsection{Number Comparison}
@defproc[(= [z number?] [w number?] ...+) boolean?]{ Returns
@racket[#t] if all of the arguments are numerically equal,
@ -453,7 +465,7 @@ Among the real numbers within @racket[(abs tolerance)] of @racket[x],
@; ------------------------------------------------------------------------
@section{Powers and Roots}
@subsection{Powers and Roots}
@defproc[(sqrt [z number?]) number?]{
@ -512,7 +524,7 @@ Returns the natural logarithm of @racket[z]. The result is normally
@; ------------------------------------------------------------------------
@section{Trignometric Functions}
@subsection{Trignometric Functions}
@defproc[(sin [z number?]) number?]{
@ -574,7 +586,7 @@ In the two-argument case, the result is roughly the same as @racket[(/
@mz-examples[(atan 0.5) (atan 2 1) (atan -2 -1) (atan 1+05.i) (atan +inf.0 -inf.0)]}
@; ------------------------------------------------------------------------
@section{Complex Numbers}
@subsection{Complex Numbers}
@defproc[(make-rectangular [x real?] [y real?]) number?]{
@ -623,7 +635,7 @@ Returns the imaginary part of the complex number @racket[z] in
@mz-examples[(angle -3) (angle 3.0) (angle 3+4i) (angle +inf.0+inf.0i)]}
@; ------------------------------------------------------------------------
@section{Bitwise Operations}
@subsection{Bitwise Operations}
@section-index{logical operators}
@ -721,7 +733,7 @@ both in binary and as integers.
@mz-examples[(integer-length 8) (integer-length -8)]}
@; ------------------------------------------------------------------------
@section{Random Numbers}
@subsection{Random Numbers}
@defproc*[([(random [k (integer-in 1 4294967087)]
[generator pseudo-random-generator?
@ -801,7 +813,7 @@ Like @racket[vector->pseudo-random-generator], but changes
generator.}
@; ------------------------------------------------------------------------
@section{Number--String Conversions}
@subsection{Number--String Conversions}
@section-index["numbers" "machine representations"]
@section-index["numbers" "floating-point"]
@ -946,383 +958,7 @@ for the machine running Racket, @racket[#f] if the native encoding
is little-endian.}
@; ------------------------------------------------------------------------
@section{Inexact-Real (Flonum) Operations}
@defmodule[racket/flonum]
The @racketmodname[racket/flonum] library provides operations like
@racket[fl+] that consume and produce only real @tech{inexact
numbers}, which are also known as @deftech{flonums}. Flonum-specific
operations provide can better performance when used consistently, and
they are as safe as generic operations like @racket[+].
@guidealso["fixnums+flonums"]
@subsection{Flonum Arithmetic}
@deftogether[(
@defproc[(fl+ [a inexact-real?] [b inexact-real?]) inexact-real?]
@defproc[(fl- [a inexact-real?] [b inexact-real?]) inexact-real?]
@defproc[(fl* [a inexact-real?] [b inexact-real?]) inexact-real?]
@defproc[(fl/ [a inexact-real?] [b inexact-real?]) inexact-real?]
@defproc[(flabs [a inexact-real?]) inexact-real?]
)]{
Like @racket[+], @racket[-], @racket[*], @racket[/], and @racket[abs],
but constrained to consume @tech{flonums}. The result is always a
@tech{flonum}.}
@deftogether[(
@defproc[(fl= [a inexact-real?] [b inexact-real?]) boolean?]
@defproc[(fl< [a inexact-real?] [b inexact-real?]) boolean?]
@defproc[(fl> [a inexact-real?] [b inexact-real?]) boolean?]
@defproc[(fl<= [a inexact-real?] [b inexact-real?]) boolean?]
@defproc[(fl>= [a inexact-real?] [b inexact-real?]) boolean?]
@defproc[(flmin [a inexact-real?] [b inexact-real?]) inexact-real?]
@defproc[(flmax [a inexact-real?] [b inexact-real?]) inexact-real?]
)]{
Like @racket[=], @racket[<], @racket[>], @racket[<=], @racket[>=],
@racket[min], and @racket[max], but constrained to consume
@tech{flonums}.}
@deftogether[(
@defproc[(flround [a inexact-real?]) inexact-real?]
@defproc[(flfloor [a inexact-real?]) inexact-real?]
@defproc[(flceiling [a inexact-real?]) inexact-real?]
@defproc[(fltruncate [a inexact-real?]) inexact-real?]
)]{
Like @racket[round], @racket[floor], @racket[ceiling], and
@racket[truncate], but constrained to consume @tech{flonums}.}
@deftogether[(
@defproc[(flsin [a inexact-real?]) inexact-real?]
@defproc[(flcos [a inexact-real?]) inexact-real?]
@defproc[(fltan [a inexact-real?]) inexact-real?]
@defproc[(flasin [a inexact-real?]) inexact-real?]
@defproc[(flacos [a inexact-real?]) inexact-real?]
@defproc[(flatan [a inexact-real?]) inexact-real?]
@defproc[(fllog [a inexact-real?]) inexact-real?]
@defproc[(flexp [a inexact-real?]) inexact-real?]
@defproc[(flsqrt [a inexact-real?]) inexact-real?]
)]{
Like @racket[sin], @racket[cos], @racket[tan], @racket[asin],
@racket[acos], @racket[atan], @racket[log], @racket[exp], and
@racket[flsqrt], but constrained to consume and produce
@tech{flonums}. The result is @racket[+nan.0] when a number outside
the range @racket[-1.0] to @racket[1.0] is given to @racket[flasin] or
@racket[flacos], or when a negative number is given to @racket[fllog]
or @racket[flsqrt].}
@defproc[(->fl [a exact-integer?]) inexact-real?]{
Like @racket[exact->inexact], but constrained to consume exact
integers, so the result is always a @tech{flonum}.}
@defproc[(fl->exact-integer [a inexact-real?]) exact-integer?]{
Like @racket[inexact->exact], but constrained to consume an
@tech{integer} @tech{flonum}, so the result is always an exact
integer.}
@deftogether[(
@defproc[(make-flrectangular [a inexact-real?] [b inexact-real?])
(and/c complex? inexact? (not/c real?))]
@defproc[(flreal-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
@defproc[(flimag-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
)]{
Like @racket[make-rectangular], @racket[real-part], and
@racket[imag-part], but both parts of the complex number must be
inexact.}
@subsection{Flonum Vectors}
A @deftech{flvector} is like a @tech{vector}, but it holds only
inexact real numbers. This representation can be more compact, and
unsafe operations on @tech{flvector}s (see
@racketmodname[racket/unsafe/ops]) can execute more efficiently than
unsafe operations on @tech{vectors} of inexact reals.
An f64vector as provided by @racketmodname[ffi/vector] stores the
same kinds of values as an @tech{flvector}, but with extra
indirections that make f64vectors more convenient for working with
foreign libraries. The lack of indirections make unsafe
@tech{flvector} access more efficient.
Two @tech{flvectors} are @racket[equal?] if they have the same length,
and if the values in corresponding slots of the @tech{flvectors} are
@racket[equal?].
@defproc[(flvector? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{flvector}, @racket[#f] otherwise.}
@defproc[(flvector [x inexact-real?] ...) flvector?]{
Creates a @tech{flvector} containing the given inexact real numbers.
@mz-examples[#:eval flfx-eval (flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-flvector [size exact-nonnegative-integer?]
[x inexact-real? 0.0])
flvector?]{
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
@mz-examples[#:eval flfx-eval (make-flvector 4 3.0)]}
@defproc[(flvector-length [vec flvector?]) exact-nonnegative-integer?]{
Returns the length of @racket[vec] (i.e., the number of slots in the
@tech{flvector}).}
@defproc[(flvector-ref [vec flvector?] [pos exact-nonnegative-integer?])
inexact-real?]{
Returns the inexact real number in slot @racket[pos] of
@racket[vec]. The first slot is position @racket[0], and the last slot
is one less than @racket[(flvector-length vec)].}
@defproc[(flvector-set! [vec flvector?] [pos exact-nonnegative-integer?]
[x inexact-real?])
inexact-real?]{
Sets the inexact real number in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(flvector-length vec)].}
@defproc[(flvector-copy [vec flvector?]
[start exact-nonnegative-integer? 0]
[end exact-nonnegative-integer? (vector-length v)])
flvector?]{
Creates a fresh @tech{flvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).}
@defproc[(in-flvector (v flvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
elements of @scheme[v] efficiently as in @scheme[in-list],
@scheme[in-vector], etc.}
@deftogether[(
@defform*[((for/flvector (for-clause ...) body ...)
(for/flvector #:length length-expr (for-clause ...) body ...))]
@defform*[((for*/flvector (for-clause ...) body ...)
(for*/flvector #:length length-expr (for-clause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{flvector}s.}
@defproc[(shared-flvector [x inexact-real?] ...) flvector?]{
Creates a @tech{flvector} containing the given inexact real numbers.
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (shared-flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-shared-flvector [size exact-nonnegative-integer?]
[x inexact-real? 0.0])
flvector?]{
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (make-shared-flvector 4 3.0)]}
@section{Fixnum Operations}
@defmodule[racket/fixnum]
The @racketmodname[racket/fixnum] library provides operations like
@racket[fx+] that consume and produce only fixnums. The operations in
this library are meant to be safe versions of unsafe operations like
@racket[unsafe-fx+]. These safe operations are generally no faster
than using generic primitives like @racket[+].
The expected use of the @racketmodname[racket/fixnum] library is for
code where the @racket[require] of @racketmodname[racket/fixnum] is
replaced with
@racketblock[(require (filtered-in
(λ (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))]
to drop in unsafe versions of the library. Alternately, when
encountering crashes with code that uses unsafe fixnum operations, use
the @racketmodname[racket/fixnum] library to help debug the problems.
@subsection{Fixnum Arithmetic}
@deftogether[(
@defproc[(fx+ [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fx- [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fx* [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxquotient [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxremainder [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxmodulo [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxabs [a fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx+], @racket[unsafe-fx-],
@racket[unsafe-fx*], @racket[unsafe-fxquotient],
@racket[unsafe-fxremainder], @racket[unsafe-fxmodulo], and
@racket[unsafe-fxabs]. The
@exnraise[exn:fail:contract:non-fixnum-result] if the arithmetic
result would not be a fixnum.}
@deftogether[(
@defproc[(fxand [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxior [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxxor [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxnot [a fixnum?]) fixnum?]
@defproc[(fxlshift [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxrshift [a fixnum?] [b fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fxand], @racket[unsafe-fxior],
@racket[unsafe-fxxor], @racket[unsafe-fxnot],
@racket[unsafe-fxlshift], and @racket[unsafe-fxrshift]. The
@exnraise[exn:fail:contract:non-fixnum-result] if the arithmetic
result would not be a fixnum.}
@deftogether[(
@defproc[(fx= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx< [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx> [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx<= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fx>= [a fixnum?] [b fixnum?]) boolean?]
@defproc[(fxmin [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fxmax [a fixnum?] [b fixnum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<],
@racket[unsafe-fx>], @racket[unsafe-fx<=], @racket[unsafe-fx>=],
@racket[unsafe-fxmin], and @racket[unsafe-fxmax].}
@deftogether[(
@defproc[(fx->fl [a fixnum?]) inexact-real?]
@defproc[(fl->fx [a inexact-real?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx->fl] and @racket[unsafe-fl->fx].}
@subsection{Fixnum Vectors}
A @deftech{fxvector} is like a @tech{vector}, but it holds only
@tech{fixnums}. The only advantage of an @tech{fxvector} over a
@tech{vector} is that a shared version can be created with functions
like @racket[shared-fxvector].
Two @tech{fxvectors} are @racket[equal?] if they have the same length,
and if the values in corresponding slots of the @tech{fxvectors} are
@racket[equal?].
@defproc[(fxvector? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{fxvector}, @racket[#f] otherwise.}
@defproc[(fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
@mz-examples[#:eval flfx-eval (fxvector 2 3 4 5)]}
@defproc[(make-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
@mz-examples[#:eval flfx-eval (make-fxvector 4 3)]}
@defproc[(fxvector-length [vec fxvector?]) exact-nonnegative-integer?]{
Returns the length of @racket[vec] (i.e., the number of slots in the
@tech{fxvector}).}
@defproc[(fxvector-ref [vec fxvector?] [pos exact-nonnegative-integer?])
fixnum?]{
Returns the @tech{fixnum} in slot @racket[pos] of
@racket[vec]. The first slot is position @racket[0], and the last slot
is one less than @racket[(fxvector-length vec)].}
@defproc[(fxvector-set! [vec fxvector?] [pos exact-nonnegative-integer?]
[x fixnum?])
fixnum?]{
Sets the @tech{fixnum} in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(fxvector-length vec)].}
@defproc[(fxvector-copy [vec fxvector?]
[start exact-nonnegative-integer? 0]
[end exact-nonnegative-integer? (vector-length v)])
fxvector?]{
Creates a fresh @tech{fxvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).}
@defproc[(in-fxvector (v fxvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
elements of @scheme[v] efficiently as in @scheme[in-list],
@scheme[in-vector], etc.}
@deftogether[(
@defform*[((for/fxvector (for-clause ...) body ...)
(for/fxvector #:length length-expr (for-clause ...) body ...))]
@defform*[((for*/fxvector (for-clause ...) body ...)
(for*/fxvector #:length length-expr (for-clause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{fxvector}s.}
@defproc[(shared-fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (shared-fxvector 2 3 4 5)]}
@defproc[(make-shared-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (make-shared-fxvector 4 3)]}
@; ------------------------------------------------------------------------
@section{Extra Constants and Functions}
@subsection{Extra Constants and Functions}
@note-lib[racket/math]
@ -1385,6 +1021,11 @@ Hence also:
}
@; ----------------------------------------------------------------------
@close-eval[math-eval]
@close-eval[flfx-eval]
@; ----------------------------------------------------------------------
@include-section["flonums.scrbl"]
@include-section["fixnums.scrbl"]
@; ----------------------------------------------------------------------

View File

@ -129,10 +129,12 @@ printed form of its exact negation.
@section{Printing Booleans}
The constant @scheme[#t] prints as @litchar{#t}, and the constant
@scheme[#f] prints as @litchar{#f} in all modes (@scheme[display],
@scheme[write], and @scheme[print]). For the purposes of printing
enclosing datatypes, a symbol is @tech{quotable}.
The constant @scheme[#t] prints as @litchar{#true} or @litchar{#t} in
all modes (@scheme[display], @scheme[write], and @scheme[print]),
depending on the value of @racket[print-boolean-long-form], and the
constant @scheme[#f] prints as @litchar{#false} or @litchar{#f}. For
the purposes of printing enclosing datatypes, a symbol is
@tech{quotable}.
@section[#:tag "print-pairs"]{Printing Pairs and Lists}

View File

@ -242,8 +242,15 @@ A parameter that controls parsing input with @litchar{`} or
@defboolparam[read-accept-reader on?]{
A parameter that controls whether @litchar{#reader} is allowed for
selecting a parser. See @secref["parse-reader"] for more
A parameter that controls whether @litchar{#reader}, @litchar{#lang},
and @litchar{#!} followed by a space are allowed for selecting a
parser. See @secref["parse-reader"] for more information.}
@defboolparam[read-accept-lang on?]{
A parameter that (along with @racket[read-accept-reader] controls
whether @litchar{#lang} and @litchar{#!} followed by a space are
allowed for selecting a parser. See @secref["parse-reader"] for more
information.}
@defparam[current-reader-guard proc (any/c . -> . any)]{

View File

@ -289,10 +289,12 @@ with any other mark, double-precision IEEE floating point is used.
@section[#:tag "parse-boolean"]{Reading Booleans}
A @as-index{@litchar{#t}} or @as-index{@litchar{#T}} is the complete
input syntax for the boolean constant true, and
@as-index{@litchar{#f}} or @as-index{@litchar{#F}} is the complete
input syntax for the boolean constant false.
A @as-index{@litchar{#true}}, @as-index{@litchar{#t}},
@as-index{@litchar{#T}} followed by a delimiter is the input syntax
for the boolean constant ``true,'' and @as-index{@litchar{#false}},
@as-index{@litchar{#f}}, or @as-index{@litchar{#F}} followed by a
delimiter is the complete input syntax for the boolean constant
``false.''
@section[#:tag "parse-pair"]{Reading Pairs and Lists}
@ -831,6 +833,11 @@ certain grammars, such as that of R@superscript{6}RS
By convention, @litchar{#lang} normally appears at the beginning of a
file, possibly after comment forms, to specify the syntax of a module.
If the @racket[read-accept-reader] or @racket[read-accept-lang]
@tech{parameter} is set to @racket[#f], then if the reader encounters
@litchar{#lang} or @litchar{#!} followed by a space, the
@exnraise[exn:fail:read].
@subsection{S-Expression Reader Language}
@defmodulelang[s-exp]

View File

@ -219,6 +219,15 @@ A parameter that controls printing vectors; defaults to
A parameter that controls printing hash tables; defaults to
@racket[#f]. See @secref["print-hashtable"] for more information.}
@defboolparam[print-boolean-long-form on?]{
A parameter that controls printing of booleans. When the parameter's
value is true, @racket[#t] and @racket[#f] print as @litchar{#true}
and @litchar{#false}, otherwise they print as @litchar{#t}
and @litchar{#f}.}
@defboolparam[print-reader-abbreviations on?]{
A parameter that controls printing of two-element lists that start

View File

@ -18,6 +18,7 @@
[read-accept-infix-dot #t]
[read-accept-quasiquote #t]
[read-accept-reader #t]
[read-accept-lang #t]
[current-readtable #f])
(thunk)))

View File

@ -416,4 +416,13 @@
;; ----------------------------------------
(parameterize ([print-boolean-long-form #f])
(test "#t" pretty-format #t)
(test "#f" pretty-format #f))
(parameterize ([print-boolean-long-form #t])
(test "#true" pretty-format #t)
(test "#false" pretty-format #f))
;; ----------------------------------------
(report-errs)

View File

@ -46,6 +46,12 @@
#:property prop:custom-print-quotable 'always)
(ptest "1" 1)
(parameterize ([print-boolean-long-form #f])
(ptest "#t" #t)
(ptest "#f" #f))
(parameterize ([print-boolean-long-form #t])
(ptest "#true" #t)
(ptest "#false" #f))
(ptest "1/2" 1/2)
(ptest "#f" #f)
(ptest "#\\x" #\x)

View File

@ -55,6 +55,24 @@
(err/rt-test (readstr "(8 . 9 . 1 . )") exn:fail:read?)
(err/rt-test (readstr "(8 . 9 . 1 . 10)") exn:fail:read?)
(let ([w-suffix
(lambda (s)
(test #t readstr (string-append "#t" s))
(test #t readstr (string-append "#T" s))
(test #t readstr (string-append "#true" s))
(test #f readstr (string-append "#f" s))
(test #f readstr (string-append "#F" s))
(test #f readstr (string-append "#false" s)))])
(w-suffix "")
(w-suffix " ")
(w-suffix ";")
(err/rt-test (readstr "#True") exn:fail:read?)
(err/rt-test (readstr "#tru") exn:fail:read:eof?)
(err/rt-test (readstr "#truer") exn:fail:read?)
(err/rt-test (readstr "#False") exn:fail:read?)
(err/rt-test (readstr "#fals") exn:fail:read:eof?)
(err/rt-test (readstr "#falser") exn:fail:read?))
(test (integer->char 0) readstr "#\\nul")
(test (integer->char 0) readstr "#\\Nul")
(test (integer->char 0) readstr "#\\NuL")

View File

@ -1,3 +1,13 @@
Version 5.0.1.8
Added #true and #false, and changed #t/#T and #f/#F to
require a delimiter afterward
Added print-boolean-long-form
Added read-accept-lang, which is set to #t when
reading a module
Added flonum?
Changed continuation-marks to accept a #f argument
to produce an empty set of marks
Version 5.0.1.7
Added fxvectors
Added unsafe-{s,u}16-{ref,set!}

View File

@ -1202,6 +1202,7 @@ enum {
MZCONFIG_CAN_READ_INFIX_DOT,
MZCONFIG_CAN_READ_QUASI,
MZCONFIG_CAN_READ_READER,
MZCONFIG_CAN_READ_LANG,
MZCONFIG_READ_DECIMAL_INEXACT,
MZCONFIG_PRINT_GRAPH,
@ -1214,6 +1215,7 @@ enum {
MZCONFIG_PRINT_MPAIR_CURLY,
MZCONFIG_PRINT_SYNTAX_WIDTH,
MZCONFIG_PRINT_READER,
MZCONFIG_PRINT_LONG_BOOLEAN,
MZCONFIG_PRINT_AS_QQ,
MZCONFIG_CASE_SENS,

File diff suppressed because it is too large Load Diff

View File

@ -7677,6 +7677,20 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
return (Scheme_Object *)set;
}
static Scheme_Object *make_empty_marks()
{
/* empty marks */
Scheme_Cont_Mark_Set *set;
set = MALLOC_ONE_TAGGED(Scheme_Cont_Mark_Set);
set->so.type = scheme_cont_mark_set_type;
set->chain = NULL;
set->cmpos = 1;
set->native_stack_trace = NULL;
return (Scheme_Object *)set;
}
Scheme_Object *scheme_current_continuation_marks(Scheme_Object *prompt_tag)
{
return continuation_marks(scheme_current_thread, NULL, NULL, NULL,
@ -7717,8 +7731,9 @@ cont_marks(int argc, Scheme_Object *argv[])
{
Scheme_Object *prompt_tag;
if (!SCHEME_CONTP(argv[0]) && !SCHEME_ECONTP(argv[0]) && !SCHEME_THREADP(argv[0]))
scheme_wrong_type("continuation-marks", "continuation or thread", 0, argc, argv);
if (SCHEME_TRUEP(argv[0])
&& !SCHEME_CONTP(argv[0]) && !SCHEME_ECONTP(argv[0]) && !SCHEME_THREADP(argv[0]))
scheme_wrong_type("continuation-marks", "continuation, thread, or #f", 0, argc, argv);
if (argc > 1) {
if (!SAME_TYPE(scheme_prompt_tag_type, SCHEME_TYPE(argv[1]))) {
@ -7729,7 +7744,9 @@ cont_marks(int argc, Scheme_Object *argv[])
} else
prompt_tag = scheme_default_prompt_tag;
if (SCHEME_ECONTP(argv[0])) {
if (SCHEME_FALSEP(argv[0])) {
return make_empty_marks();
} else if (SCHEME_ECONTP(argv[0])) {
if (!scheme_escape_continuation_ok(argv[0])) {
scheme_arg_mismatch("continuation-marks",
"escape continuation not in the current thread's continuation: ",
@ -7758,16 +7775,7 @@ cont_marks(int argc, Scheme_Object *argv[])
}
if (!(t->running & MZTHREAD_RUNNING)) {
/* empty marks */
Scheme_Cont_Mark_Set *set;
set = MALLOC_ONE_TAGGED(Scheme_Cont_Mark_Set);
set->so.type = scheme_cont_mark_set_type;
set->chain = NULL;
set->cmpos = 1;
set->native_stack_trace = NULL;
return (Scheme_Object *)set;
return make_empty_marks();
} else {
scheme_start_atomic(); /* just in case */

View File

@ -547,7 +547,12 @@ void scheme_future_block_until_gc()
# else
{
int _eax, _ebx, _ecx, _edx, op = 0;
asm ("cpuid" : "=a" (_eax), "=b" (_ebx), "=c" (_ecx), "=d" (_edx) : "a" (op));
/* we can't always use EBX, so save and restore it: */
asm ("pushl %%ebx \n\t"
"cpuid \n\t"
"movl %%ebx, %1 \n\t"
"popl %%ebx"
: "=a" (_eax), "=r" (_ebx), "=c" (_ecx), "=d" (_edx) : "a" (op));
}
# endif
#endif

View File

@ -6748,6 +6748,9 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
} else if (IS_NAMED_PRIM(rator, "inexact-real?")) {
generate_inlined_type_test(jitter, app, SCHEME_FLOAT_TYPE, scheme_double_type, 0, for_branch, branch_short, need_sync);
return 1;
} else if (IS_NAMED_PRIM(rator, "flonum?")) {
generate_inlined_type_test(jitter, app, scheme_double_type, scheme_double_type, 0, for_branch, branch_short, need_sync);
return 1;
} else if (IS_NAMED_PRIM(rator, "procedure?")) {
generate_inlined_type_test(jitter, app, scheme_prim_type, scheme_proc_chaperone_type, 1, for_branch, branch_short, need_sync);
return 1;

View File

@ -1043,8 +1043,8 @@ UNSAFE_FL1(unsafe_fl_sqrt, sqrt, pos_sqrt)
static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
{ \
double v; \
if (!SCHEME_FLOATP(argv[0])) scheme_wrong_type(sname, "inexact-real", 0, argc, argv); \
if (!SCHEME_FLOATP(argv[1])) scheme_wrong_type(sname, "inexact-real", 1, argc, argv); \
if (!SCHEME_DBLP(argv[0])) scheme_wrong_type(sname, "flonum", 0, argc, argv); \
if (!SCHEME_DBLP(argv[1])) scheme_wrong_type(sname, "flonum", 1, argc, argv); \
v = SCHEME_DBL_VAL(argv[0]) op SCHEME_DBL_VAL(argv[1]); \
return scheme_make_double(v); \
}
@ -1058,7 +1058,7 @@ SAFE_FL(fl_div, "fl/", /)
static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
{ \
double v; \
if (!SCHEME_FLOATP(argv[0])) scheme_wrong_type(sname, "inexact-real", 0, argc, argv); \
if (!SCHEME_DBLP(argv[0])) scheme_wrong_type(sname, "flonum", 0, argc, argv); \
v = SCHEME_DBL_VAL(argv[0]); \
v = op(v); \
return scheme_make_double(v); \

View File

@ -63,6 +63,7 @@ static Scheme_Object *exact_nonnegative_integer_p (int argc, Scheme_Object *argv
static Scheme_Object *exact_positive_integer_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *fixnum_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *inexact_real_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *flonum_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *exact_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *even_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *bitwise_or (int argc, Scheme_Object *argv[]);
@ -349,6 +350,10 @@ scheme_init_number (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("inexact-real?", p, env);
p = scheme_make_folding_prim(flonum_p, "flonum?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("flonum?", p, env);
scheme_add_global_constant("exact?",
scheme_make_folding_prim(exact_p,
"exact?",
@ -1313,6 +1318,16 @@ inexact_real_p (int argc, Scheme_Object *argv[])
return scheme_false;
}
static Scheme_Object *
flonum_p (int argc, Scheme_Object *argv[])
{
Scheme_Object *n = argv[0];
if (SCHEME_DBLP(n))
return scheme_true;
else
return scheme_false;
}
int scheme_is_exact(const Scheme_Object *n)
{
if (SCHEME_INTP(n)) {
@ -2636,10 +2651,10 @@ Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[
a = argv[0];
b = argv[1];
if (!SCHEME_FLOATP(a))
scheme_wrong_type("make-rectangular", "inexact-real", 0, argc, argv);
if (!SCHEME_FLOATP(b))
scheme_wrong_type("make-rectangular", "inexact-real", 1, argc, argv);
if (!SCHEME_DBLP(a))
scheme_wrong_type("make-rectangular", "flonum", 0, argc, argv);
if (!SCHEME_DBLP(b))
scheme_wrong_type("make-rectangular", "flonum", 1, argc, argv);
return scheme_make_complex(a, b);
}
@ -3279,11 +3294,11 @@ static Scheme_Object *do_flvector (const char *name, Scheme_Double_Vector *vec,
int i;
for (i = 0; i < argc; i++) {
if (!SCHEME_FLOATP(argv[i])) {
scheme_wrong_type(name, "inexact real", i, argc, argv);
if (!SCHEME_DBLP(argv[i])) {
scheme_wrong_type(name, "flonum", i, argc, argv);
return NULL;
}
vec->els[i] = SCHEME_FLOAT_VAL(argv[i]);
vec->els[i] = SCHEME_DBL_VAL(argv[i]);
}
return (Scheme_Object *)vec;
@ -3329,8 +3344,8 @@ static Scheme_Object *do_make_flvector (const char *name, int as_shared, int arg
scheme_wrong_type(name, "exact non-negative integer", 0, argc, argv);
if (argc > 1) {
if (!SCHEME_FLOATP(argv[1]))
scheme_wrong_type(name, "inexact real", 1, argc, argv);
if (!SCHEME_DBLP(argv[1]))
scheme_wrong_type(name, "flonum", 1, argc, argv);
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
@ -3343,7 +3358,7 @@ static Scheme_Object *do_make_flvector (const char *name, int as_shared, int arg
if (argc > 1) {
int i;
double d = SCHEME_FLOAT_VAL(argv[1]);
double d = SCHEME_DBL_VAL(argv[1]);
for (i = 0; i < size; i++) {
vec->els[i] = d;
}
@ -3414,8 +3429,8 @@ Scheme_Object *scheme_checked_flvector_set (int argc, Scheme_Object *argv[])
len = SCHEME_FLVEC_SIZE(vec);
pos = scheme_extract_index("flvector-set!", 1, argc, argv, len, 0);
if (!SCHEME_FLOATP(argv[2]))
scheme_wrong_type("flvector-set!", "inexact real", 2, argc, argv);
if (!SCHEME_DBLP(argv[2]))
scheme_wrong_type("flvector-set!", "flonum", 2, argc, argv);
if (pos >= len) {
scheme_bad_vec_index("flvector-set!", argv[1],
@ -3424,7 +3439,7 @@ Scheme_Object *scheme_checked_flvector_set (int argc, Scheme_Object *argv[])
return NULL;
}
SCHEME_FLVEC_ELS(vec)[pos] = SCHEME_FLOAT_VAL(argv[2]);
SCHEME_FLVEC_ELS(vec)[pos] = SCHEME_DBL_VAL(argv[2]);
return scheme_void;
}
@ -3675,7 +3690,7 @@ static Scheme_Object *fl_to_fx (int argc, Scheme_Object *argv[])
if (!SCHEME_DBLP(argv[0])
|| !scheme_is_integer(argv[0]))
scheme_wrong_type("fl->fx", "inexact-real integer", 0, argc, argv);
scheme_wrong_type("fl->fx", "flonum integer", 0, argc, argv);
d = SCHEME_DBL_VAL(argv[0]);
v = (long)d;
@ -3693,7 +3708,7 @@ static Scheme_Object *fl_to_fx (int argc, Scheme_Object *argv[])
static Scheme_Object * fl_ ## op (int argc, Scheme_Object *argv[]) \
{ \
double v; \
if (!SCHEME_DBLP(argv[0])) scheme_wrong_type("fl" #op, "inexact-real", 0, argc, argv); \
if (!SCHEME_DBLP(argv[0])) scheme_wrong_type("fl" #op, "flonum", 0, argc, argv); \
v = scheme_double_ ## op (SCHEME_DBL_VAL(argv[0])); \
return scheme_make_double(v); \
}
@ -3790,7 +3805,7 @@ static Scheme_Object *unsafe_flvector_set (int argc, Scheme_Object *argv[])
long pos;
pos = SCHEME_INT_VAL(argv[1]);
SCHEME_FLVEC_ELS(argv[0])[pos] = SCHEME_FLOAT_VAL(argv[2]);
SCHEME_FLVEC_ELS(argv[0])[pos] = SCHEME_DBL_VAL(argv[2]);
return scheme_void;
}
@ -3872,7 +3887,7 @@ static Scheme_Object *fl_to_integer (int argc, Scheme_Object *argv[])
return o;
}
scheme_wrong_type("fl->exact-integer", "inexact-real integer", 0, argc, argv);
scheme_wrong_type("fl->exact-integer", "flonum integer", 0, argc, argv);
return NULL;
}

View File

@ -563,8 +563,8 @@ UNSAFE_FX_X(unsafe_fx_max, >, bin_max, argv[0], argv[1], FX_SEL_ID)
#define SAFE_FL_X(name, sname, op, T, F) \
static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
{ \
if (!SCHEME_FLOATP(argv[0])) scheme_wrong_type(sname, "inexact-real", 0, argc, argv); \
if (!SCHEME_FLOATP(argv[1])) scheme_wrong_type(sname, "inexact-real", 1, argc, argv); \
if (!SCHEME_DBLP(argv[0])) scheme_wrong_type(sname, "flonum", 0, argc, argv); \
if (!SCHEME_DBLP(argv[1])) scheme_wrong_type(sname, "flonum", 1, argc, argv); \
if (SCHEME_DBL_VAL(argv[0]) op SCHEME_DBL_VAL(argv[1])) \
return T; \
else \

View File

@ -398,7 +398,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (radix_set) {
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad radix specification: %u",
"read: bad radix specification: %u",
str, len);
else
return scheme_false;
@ -408,7 +408,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (is_float || is_not_float) {
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad exactness specification: %u",
"read: bad exactness specification: %u",
str, len);
else
return scheme_false;
@ -443,7 +443,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
default:
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad `#' indicator `%c': %u",
"read: bad `#' indicator `%c': %u",
str[delta+1], str, len);
return scheme_false;
}
@ -458,7 +458,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (!(len - delta)) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no digits");
"read: no digits");
return scheme_false;
}
@ -471,7 +471,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
return special;
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no exact representation for %V",
"read: no exact representation for %V",
special);
return scheme_false;
}
@ -515,7 +515,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (is_not_float) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no exact representation for %V",
"read: no exact representation for %V",
special);
return scheme_false;
}
@ -532,7 +532,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
*div_by_zero = 1;
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero: %u",
"read: division by zero: %u",
str, len);
return scheme_false;
}
@ -553,7 +553,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (is_not_float) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no exact representation for %V",
"read: no exact representation for %V",
special);
return scheme_false;
}
@ -616,7 +616,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
*div_by_zero = 1;
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero: %u",
"read: division by zero: %u",
str, len);
return scheme_false;
}
@ -662,7 +662,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (!ch) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: embedded null character: %u",
"read: embedded null character: %u",
str, len);
return scheme_false;
} else if (isinexactmark(ch) && ((radix <= 10) || !isbaseNdigit(radix, ch))) {
@ -673,7 +673,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if ((has_sign > delta) || ((has_sign == delta) && (i == delta+1))) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: too many signs: %u",
"read: too many signs: %u",
str, len);
return scheme_false;
}
@ -682,14 +682,14 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_at) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: cannot mix `@' and `i': %u",
"read: cannot mix `@' and `i': %u",
str, len);
return scheme_false;
}
if (i + 1 < len) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: `i' must be at the end: %u",
"read: `i' must be at the end: %u",
str, len);
return scheme_false;
}
@ -698,14 +698,14 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_at) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: too many `@'s: %u",
"read: too many `@'s: %u",
str, len);
return scheme_false;
}
if (i == delta) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: `@' cannot be at start: %u",
"read: `@' cannot be at start: %u",
str, len);
return scheme_false;
}
@ -779,7 +779,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
*div_by_zero = 1;
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero: %u",
"read: division by zero: %u",
str, len);
return scheme_false;
}
@ -872,7 +872,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
*div_by_zero = 1;
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero in %u",
"read: division by zero in %u",
str, len);
return scheme_false;
}
@ -912,14 +912,14 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_decimal) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: multiple decimal points: %u",
"read: multiple decimal points: %u",
str, len);
return scheme_false;
}
if (has_slash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: decimal points and fractions "
"read: decimal points and fractions "
"cannot be mixed: %u",
str, len);
return scheme_false;
@ -930,7 +930,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (i == delta) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: cannot begin with `%c' in %u",
"read: cannot begin with `%c' in %u",
ch, str, len);
return scheme_false;
}
@ -940,21 +940,21 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (i == delta) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: cannot have slash at start: %u",
"read: cannot have slash at start: %u",
str, len);
return scheme_false;
}
if (has_slash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: multiple slashes: %u",
"read: multiple slashes: %u",
str, len);
return scheme_false;
}
if (has_decimal) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: decimal points and fractions "
"read: decimal points and fractions "
"cannot be mixed: %u",
str, len);
return scheme_false;
@ -966,7 +966,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_slash || has_decimal || has_hash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: misplaced sign: %u",
"read: misplaced sign: %u",
str, len);
return scheme_false;
}
@ -974,7 +974,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (!saw_digit_since_slash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: misplaced hash: %u",
"read: misplaced hash: %u",
str, len);
return scheme_false;
}
@ -984,14 +984,14 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_decimal) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad decimal number: %u",
"read: bad decimal number: %u",
str, len);
return scheme_false;
}
if (has_hash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: misplaced hash: %u",
"read: misplaced hash: %u",
str, len);
return scheme_false;
}
@ -1004,7 +1004,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_hash_since_slash) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: misplaced hash: %u",
"read: misplaced hash: %u",
str, len);
return scheme_false;
}
@ -1041,7 +1041,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (has_expt && !(str[has_expt + 1])) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no digits after \"%c\": %u",
"read: no digits after \"%c\": %u",
str[has_expt], str, len);
return scheme_false;
}
@ -1069,7 +1069,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if ((ptr XFORM_OK_MINUS ffl_buf) < (len - delta)) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad decimal number %u",
"read: bad decimal number %u",
str, len);
return scheme_false;
}
@ -1114,7 +1114,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (!str[has_expt + 1]) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no digits after \"%c\": %u",
"read: no digits after \"%c\": %u",
str[has_expt], str, len);
return scheme_false;
}
@ -1134,7 +1134,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (SCHEME_FALSEP(exponent)) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad exponent: %u",
"read: bad exponent: %u",
str, len);
return scheme_false;
}
@ -1167,12 +1167,12 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
*div_by_zero = 1;
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero: %u",
"read: division by zero: %u",
str, len);
}
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad number: %u",
"read: bad number: %u",
str, len);
return scheme_false;
}
@ -1218,7 +1218,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
|| ((radix > 10) && isbaseNdigit(radix, digits[0]))))) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad decimal number %u",
"read: bad decimal number %u",
str, len);
return scheme_false;
}
@ -1237,7 +1237,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
/* can get here with bad radix */
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad number: %u",
"read: bad number: %u",
str, len);
return scheme_false;
}
@ -1339,7 +1339,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (SCHEME_EXACT_REALP(n2) && scheme_is_zero(n2)) {
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: division by zero: %u",
"read: division by zero: %u",
str, len);
if (div_by_zero)
*div_by_zero = 1;
@ -1356,7 +1356,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (!scheme_check_double(NULL, SCHEME_FLOAT_VAL(n1), NULL)) {
if (complain)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: no exact representation for %V",
"read: no exact representation for %V",
n1);
return scheme_false;
}
@ -1372,7 +1372,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, long len,
if (SAME_OBJ(o, scheme_false)) {
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read-number: bad number: %u",
"read: bad number: %u",
str, len);
} else if (is_float) {
/* Special case: "#i-0" => -0. */

View File

@ -4312,6 +4312,7 @@ static Scheme_Object *default_load(int argc, Scheme_Object *argv[])
config = scheme_extend_config(config, MZCONFIG_CAN_READ_INFIX_DOT, scheme_true);
config = scheme_extend_config(config, MZCONFIG_CAN_READ_QUASI, scheme_true);
config = scheme_extend_config(config, MZCONFIG_CAN_READ_READER, scheme_true);
config = scheme_extend_config(config, MZCONFIG_CAN_READ_LANG, scheme_true);
config = scheme_extend_config(config, MZCONFIG_READ_DECIMAL_INEXACT, scheme_true);
config = scheme_extend_config(config, MZCONFIG_READTABLE, scheme_false);
}

View File

@ -80,6 +80,7 @@ typedef struct Scheme_Print_Params {
char print_unreadable;
char print_pair_curly, print_mpair_curly;
char print_reader;
char print_long_bools;
char can_read_pipe_quote;
char case_sens;
char honu_mode;
@ -989,6 +990,7 @@ print_to_string(Scheme_Object *obj,
params.print_hash_table = 0;
params.print_unreadable = 1;
params.print_reader = 1;
params.print_long_bools = 0;
params.print_pair_curly = 0;
params.print_mpair_curly = 1;
params.can_read_pipe_quote = 1;
@ -1053,6 +1055,8 @@ print_to_string(Scheme_Object *obj,
params.can_read_pipe_quote = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_CASE_SENS);
params.case_sens = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_PRINT_LONG_BOOLEAN);
params.print_long_bools = SCHEME_TRUEP(v);
if (check_honu) {
v = scheme_get_param(config, MZCONFIG_HONU_MODE);
params.honu_mode = SCHEME_TRUEP(v);
@ -2234,6 +2238,8 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
print_compact(pp, CPT_TRUE);
else if (pp->honu_mode)
print_utf8_string(pp, "true", 0, 4);
else if (pp->print_long_bools)
print_utf8_string(pp, "#true", 0, 5);
else
print_utf8_string(pp, "#t", 0, 2);
}
@ -2243,6 +2249,8 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
print_compact(pp, CPT_FALSE);
else if (pp->honu_mode)
print_utf8_string(pp, "false", 0, 5);
else if (pp->print_long_bools)
print_utf8_string(pp, "#false", 0, 6);
else
print_utf8_string(pp, "#f", 0, 2);
}

View File

@ -105,6 +105,7 @@ static Scheme_Object *read_accept_dot(int, Scheme_Object *[]);
static Scheme_Object *read_accept_infix_dot(int, Scheme_Object *[]);
static Scheme_Object *read_accept_quasi(int, Scheme_Object *[]);
static Scheme_Object *read_accept_reader(int, Scheme_Object *[]);
static Scheme_Object *read_accept_lang(int, Scheme_Object *[]);
#ifdef LOAD_ON_DEMAND
static Scheme_Object *read_delay_load(int, Scheme_Object *[]);
#endif
@ -120,6 +121,7 @@ static Scheme_Object *print_honu(int, Scheme_Object *[]);
static Scheme_Object *print_syntax_width(int, Scheme_Object *[]);
static Scheme_Object *print_reader(int, Scheme_Object *[]);
static Scheme_Object *print_as_qq(int, Scheme_Object *[]);
static Scheme_Object *print_long_bool(int, Scheme_Object *[]);
static int scheme_ellipses(mzchar* buffer, int length);
@ -164,20 +166,21 @@ typedef struct Readtable {
typedef struct ReadParams {
MZTAG_IF_REQUIRED
int can_read_compiled;
int can_read_pipe_quote;
int can_read_box;
int can_read_graph;
int can_read_reader;
int case_sensitive;
int square_brackets_are_parens;
int curly_braces_are_parens;
int read_decimal_inexact;
int can_read_dot;
int can_read_infix_dot;
int can_read_quasi;
int honu_mode;
int skip_zo_vers_check;
char can_read_compiled;
char can_read_pipe_quote;
char can_read_box;
char can_read_graph;
char can_read_reader;
char can_read_lang;
char case_sensitive;
char square_brackets_are_parens;
char curly_braces_are_parens;
char read_decimal_inexact;
char can_read_dot;
char can_read_infix_dot;
char can_read_quasi;
char honu_mode;
char skip_zo_vers_check;
Readtable *table;
Scheme_Object *magic_sym, *magic_val;
Scheme_Object *delay_load_info;
@ -240,6 +243,12 @@ static Scheme_Object *read_keyword(int init_ch,
Scheme_Object *indentation,
ReadParams *params,
Readtable *table);
static Scheme_Object *read_delimited_constant(int ch, const mzchar *str,
Scheme_Object *v,
Scheme_Object *port,
Scheme_Object *stxsrc, long line, long col, long pos,
Scheme_Object *indentation,
ReadParams *params, Readtable *table);
static Scheme_Object *read_character(Scheme_Object *port, Scheme_Object *stcsrc,
long line, long col, long pos,
Scheme_Hash_Table **ht,
@ -282,6 +291,10 @@ static Scheme_Object *expected_lang(const char *prefix, int ch,
long line, long col, long pos,
int get_info);
static void pop_indentation(Scheme_Object *indentation);
static int next_is_delim(Scheme_Object *port,
ReadParams *params,
int brackets,
int braces);
static int skip_whitespace_comments(Scheme_Object *port, Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
@ -526,6 +539,7 @@ void scheme_init_read(Scheme_Env *env)
GLOBAL_PARAMETER("read-accept-infix-dot", read_accept_infix_dot, MZCONFIG_CAN_READ_INFIX_DOT, env);
GLOBAL_PARAMETER("read-accept-quasiquote", read_accept_quasi, MZCONFIG_CAN_READ_QUASI, env);
GLOBAL_PARAMETER("read-accept-reader", read_accept_reader, MZCONFIG_CAN_READ_READER, env);
GLOBAL_PARAMETER("read-accept-lang", read_accept_lang, MZCONFIG_CAN_READ_LANG, env);
#ifdef LOAD_ON_DEMAND
GLOBAL_PARAMETER("read-on-demand-source", read_delay_load, MZCONFIG_DELAY_LOAD_INFO, env);
#endif
@ -540,6 +554,7 @@ void scheme_init_read(Scheme_Env *env)
GLOBAL_PARAMETER("print-honu", print_honu, MZCONFIG_HONU_MODE, env);
GLOBAL_PARAMETER("print-syntax-width", print_syntax_width, MZCONFIG_PRINT_SYNTAX_WIDTH, env);
GLOBAL_PARAMETER("print-reader-abbreviations", print_reader, MZCONFIG_PRINT_READER, env);
GLOBAL_PARAMETER("print-boolean-long-form", print_long_bool, MZCONFIG_PRINT_LONG_BOOLEAN, env);
GLOBAL_PARAMETER("print-as-expression", print_as_qq, MZCONFIG_PRINT_AS_QQ, env);
GLOBAL_PRIM_W_ARITY("make-readtable", make_readtable, 1, -1, env);
@ -704,6 +719,12 @@ read_accept_reader(int argc, Scheme_Object *argv[])
DO_CHAR_PARAM("read-accept-reader", MZCONFIG_CAN_READ_READER);
}
static Scheme_Object *
read_accept_lang(int argc, Scheme_Object *argv[])
{
DO_CHAR_PARAM("read-accept-lang", MZCONFIG_CAN_READ_LANG);
}
static Scheme_Object *
print_graph(int argc, Scheme_Object *argv[])
{
@ -770,6 +791,12 @@ print_as_qq(int argc, Scheme_Object *argv[])
DO_CHAR_PARAM("print-as-expression", MZCONFIG_PRINT_AS_QQ);
}
static Scheme_Object *
print_long_bool(int argc, Scheme_Object *argv[])
{
DO_CHAR_PARAM("print-boolean-long-form", MZCONFIG_PRINT_LONG_BOOLEAN);
}
static Scheme_Object *good_syntax_width(int c, Scheme_Object **argv)
{
int ok;
@ -1188,18 +1215,32 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
break;
case 'T':
case 't':
if (!params->honu_mode) {
return (stxsrc
? scheme_make_stx_w_offset(scheme_true, line, col, pos, 2, stxsrc, STX_SRCTAG)
: scheme_true);
}
if (!params->honu_mode) {
if (next_is_delim(port, params, 1, 1)) {
/* found delimited `#t' */
return (stxsrc
? scheme_make_stx_w_offset(scheme_true, line, col, pos, 2, stxsrc, STX_SRCTAG)
: scheme_true);
} else {
GC_CAN_IGNORE const mzchar str[] = { 't', 'r', 'u', 'e', 0 };
return read_delimited_constant(ch, str, scheme_true, port, stxsrc, line, col, pos,
indentation, params, table);
}
}
case 'F':
case 'f':
if (!params->honu_mode) {
return (stxsrc
? scheme_make_stx_w_offset(scheme_false, line, col, pos, 2, stxsrc, STX_SRCTAG)
: scheme_false);
}
if (!params->honu_mode) {
if (next_is_delim(port, params, 1, 1)) {
/* found delimited `#f' */
return (stxsrc
? scheme_make_stx_w_offset(scheme_false, line, col, pos, 2, stxsrc, STX_SRCTAG)
: scheme_false);
} else {
GC_CAN_IGNORE const mzchar str[] = { 'f', 'a', 'l', 's', 'e', 0 };
return read_delimited_constant(ch, str, scheme_false, port, stxsrc, line, col, pos,
indentation, params, table);
}
}
case 'c':
case 'C':
if (!params->honu_mode) {
@ -1350,7 +1391,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
case 'E':
case 'e':
if (!params->honu_mode) {
return read_number(-1, port, stxsrc, line, col, pos, 0, 1, 10, 0, ht, indentation, params, table);
return read_number(-1, port, stxsrc, line, col, pos, 0, 1, 10, 0, ht, indentation, params, table);
}
break;
case 'I':
@ -1490,7 +1531,8 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
if (ch == ' ') {
/* #lang */
Scheme_Object *v;
if (!params->can_read_reader) {
if (!params->can_read_reader
|| !params->can_read_lang) {
scheme_read_err(port, stxsrc, line, col, pos, 6, 0, indentation,
"read: #lang expressions not currently enabled");
return NULL;
@ -1675,7 +1717,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
break;
}
} while (str[scanpos]);
if (!failed) {
/* Found recognized tag. Look for open paren... */
int effective_ch, kind;
@ -2356,9 +2398,12 @@ _internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cant_fai
params.can_read_graph = SCHEME_TRUEP(v);
if (crc || get_info) {
params.can_read_reader = 1;
params.can_read_lang = 1;
} else {
v = scheme_get_param(config, MZCONFIG_CAN_READ_READER);
params.can_read_reader = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_CAN_READ_LANG);
params.can_read_lang = SCHEME_TRUEP(v);
}
v = scheme_get_param(config, MZCONFIG_CASE_SENS);
params.case_sensitive = SCHEME_TRUEP(v);
@ -3854,6 +3899,63 @@ read_keyword(int init_ch,
ht, indentation, params, table);
}
static Scheme_Object *
read_delimited_constant(int ch, const mzchar *str,
Scheme_Object *v,
Scheme_Object *port,
Scheme_Object *stxsrc, long line, long col, long pos,
Scheme_Object *indentation,
ReadParams *params, Readtable *table)
{
int first_ch = ch;
int scanpos = 1;
if (ch == str[0]) { /* might be `T' instead of `t', for example */
do {
ch = scheme_getc_special_ok(port);
if ((mzchar)ch == str[scanpos]) {
scanpos++;
} else {
break;
}
} while (str[scanpos]);
} else {
/* need to show next character to show why it's wrong: */
ch = scheme_getc_special_ok(port);
}
if (str[scanpos]
|| !next_is_delim(port, params, 1, 1)) {
mzchar str_part[7], one_more[2];
if (!str[scanpos]) {
/* get non-delimiter again: */
ch = scheme_getc_special_ok(port);
}
memcpy(str_part, str XFORM_OK_PLUS 1, (scanpos - 1) * sizeof(mzchar));
str_part[scanpos - 1] = 0;
if (NOT_EOF_OR_SPECIAL(ch)) {
one_more[0] = ch;
one_more[1] = 0;
} else
one_more[0] = 0;
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos),
ch, indentation,
"read: bad syntax `#%c%5%u'",
first_ch,
str_part,
one_more,
NOT_EOF_OR_SPECIAL(ch) ? 1 : 0);
return NULL;
}
return (stxsrc
? scheme_make_stx_w_offset(v, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG)
: v);
}
static int check_honu_num(mzchar *buf, int i)
{
int j, found_e = 0, found_dot = 0;

View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1011
#define EXPECTED_PRIM_COUNT 1014
#define EXPECTED_UNSAFE_COUNT 76
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 5

View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.0.1.7"
#define MZSCHEME_VERSION "5.0.1.8"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_W 8
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

View File

@ -6789,6 +6789,7 @@ static void make_initial_config(Scheme_Thread *p)
init_param(cells, paramz, MZCONFIG_CAN_READ_QUASI, scheme_true);
init_param(cells, paramz, MZCONFIG_READ_DECIMAL_INEXACT, scheme_true);
init_param(cells, paramz, MZCONFIG_CAN_READ_READER, scheme_false);
init_param(cells, paramz, MZCONFIG_CAN_READ_LANG, scheme_false);
init_param(cells, paramz, MZCONFIG_LOAD_DELAY_ENABLED, init_load_on_demand ? scheme_true : scheme_false);
init_param(cells, paramz, MZCONFIG_DELAY_LOAD_INFO, scheme_false);
@ -6801,6 +6802,7 @@ static void make_initial_config(Scheme_Thread *p)
init_param(cells, paramz, MZCONFIG_PRINT_PAIR_CURLY, scheme_false);
init_param(cells, paramz, MZCONFIG_PRINT_MPAIR_CURLY, scheme_true);
init_param(cells, paramz, MZCONFIG_PRINT_READER, scheme_false);
init_param(cells, paramz, MZCONFIG_PRINT_LONG_BOOLEAN, scheme_false);
init_param(cells, paramz, MZCONFIG_PRINT_AS_QQ, scheme_true);
init_param(cells, paramz, MZCONFIG_PRINT_SYNTAX_WIDTH, scheme_make_integer(32));