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

Add a single-flonum? predicate to test for single-precision floats.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-01-17 17:34:04 -05:00
parent ac76d963b0
commit 03ec1ec501
8 changed files with 536 additions and 488 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/racket/private/base.rkt
View File

@ -21,6 +21,7 @@
with-output-to-file
regexp-replace*
new-apply-proc)
(rename flonum? double-flonum?) ; for symmetry with single-flonum?
struct
(all-from "hash.rkt")
(all-from "list.rkt")

6
collects/scribblings/reference/numbers.scrbl
View File

@ -159,6 +159,12 @@ syntax transformers can lead to platform-dependent bytecode files.}
Return @racket[#t] if @racket[v] is a @techlink{flonum}, @racket[#f]
otherwise.}
@defproc[(double-flonum? [v any/c]) boolean?]{
Identical to @racket[flonum?]}.
@defproc[(single-flonum? [v any/c]) boolean?]{
Return @racket[#t] if @racket[v] is a single-precision floating-point
number, @racket[#f] otherwise.}
@defproc[(zero? [z number?]) boolean?]{ Returns @racket[(= 0 z)].

21
collects/tests/racket/number.rktl
View File

@ -73,6 +73,13 @@
(test #t inexact? 0+4.0i)
(test #t inexact? 4+0.i)
(test #t flonum? 1.2)
(test #f single-flonum? 1.2)
(test #t flonum? 1.2e3)
(test #f single-flonum? 1.2e3)
(test #f flonum? 1.2f3)
(test #t single-flonum? 1.2f3)
(test #t complex? -4.242154731064108e-5-6.865001427422244e-5i)
(test #f exact? -4.242154731064108e-5-6.865001427422244e-5i)
(test #t inexact? -4.242154731064108e-5-6.865001427422244e-5i)
@ -86,42 +93,56 @@
(test #t real? +inf.0)
(test #f rational? +inf.0)
(test #f integer? +inf.0)
(test #t flonum? +inf.0)
(test #f single-flonum? +inf.0)
(test #t number? -inf.0)
(test #t complex? -inf.0)
(test #t real? -inf.0)
(test #f rational? -inf.0)
(test #f integer? -inf.0)
(test #t flonum? -inf.0)
(test #f single-flonum? -inf.0)
(test #t number? +nan.0)
(test #t complex? +nan.0)
(test #t real? +nan.0)
(test #f rational? +nan.0)
(test #f integer? +nan.0)
(test #t flonum? +nan.0)
(test #f single-flonum? +nan.0)
(test #t number? +inf.f)
(test #t complex? +inf.f)
(test #t real? +inf.f)
(test #f rational? +inf.f)
(test #f integer? +inf.f)
(test #f flonum? +inf.f)
(test #t single-flonum? +inf.f)
(test #t number? -inf.f)
(test #t complex? -inf.f)
(test #t real? -inf.f)
(test #f rational? -inf.f)
(test #f integer? -inf.f)
(test #f flonum? -inf.f)
(test #t single-flonum? -inf.f)
(test #t number? +nan.f)
(test #t complex? +nan.f)
(test #t real? +nan.f)
(test #f rational? +nan.f)
(test #f integer? +nan.f)
(test #f flonum? +nan.f)
(test #t single-flonum? +nan.f)
(test #t number? -nan.f)
(test #t complex? -nan.f)
(test #t real? -nan.f)
(test #f rational? -nan.f)
(test #f integer? -nan.f)
(test #f flonum? -nan.f)
(test #t single-flonum? -nan.f)
(arity-test inexact? 1 1)
(arity-test number? 1 1)

970
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

3
src/racket/src/jit.c
View File

@ -6812,6 +6812,9 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
} 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, "single-flonum?")) {
generate_inlined_type_test(jitter, app, SCHEME_FLOAT_TYPE, SCHEME_FLOAT_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;

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

@ -64,6 +64,7 @@ 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 *single_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[]);
@ -365,6 +366,10 @@ scheme_init_number (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("flonum?", p, env);
p = scheme_make_folding_prim(single_flonum_p, "single-flonum?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("single-flonum?", p, env);
scheme_add_global_constant("exact?",
scheme_make_folding_prim(exact_p,
"exact?",
@ -1332,6 +1337,18 @@ flonum_p (int argc, Scheme_Object *argv[])
return scheme_false;
}
static Scheme_Object *
single_flonum_p (int argc, Scheme_Object *argv[])
{
Scheme_Object *n = argv[0];
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(n))
return scheme_true;
else
#endif
return scheme_false;
}
int scheme_is_exact(const Scheme_Object *n)
{
if (SCHEME_INTP(n)) {

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

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

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.0.1"
#define MZSCHEME_VERSION "5.1.0.2"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)