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

fix error checking for flreal-part' and flimag-part'

Browse Source
This commit is contained in:
Matthew Flatt 2013-02-19 16:34:40 -07:00
parent 5e37134d94
commit 0afcda2a5a
3 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/racket/optimize.rktl
View File

@ -25,6 +25,7 @@
[a-rock (eval '(rock 0))] [a-rock (eval '(rock 0))]
[chap-rock (eval '(chaperone-struct (rock 0) rock-x (lambda (r v) (add1 v))))] [chap-rock (eval '(chaperone-struct (rock 0) rock-x (lambda (r v) (add1 v))))]
[check-error-message (lambda (name proc [fixnum? #f] [check-error-message (lambda (name proc [fixnum? #f]
#:bad-value [bad-value (if fixnum? 10 'bad)]
#:first-arg [first-arg #f] #:first-arg [first-arg #f]
#:second-arg [second-arg #f]) #:second-arg [second-arg #f])
(unless (memq name '(eq? eqv? equal? (unless (memq name '(eq? eqv? equal?
@ -40,7 +41,7 @@
thing? thing?
continuation-mark-set-first)) continuation-mark-set-first))
(let ([s (with-handlers ([exn? exn-message]) (let ([s (with-handlers ([exn? exn-message])
(let ([bad (if fixnum? 10 'bad)]) (let ([bad bad-value])
(cond (cond
[first-arg (proc first-arg bad)] [first-arg (proc first-arg bad)]
[second-arg (proc bad second-arg)] [second-arg (proc bad second-arg)]
@ -617,10 +618,12 @@
(un 1 'real-part 1+2i) (un 1 'real-part 1+2i)
(un 105 'real-part 105) (un 105 'real-part 105)
(un-exact 10.0 'flreal-part 10.0+7.0i #t) (un-exact 10.0 'flreal-part 10.0+7.0i #t)
(check-error-message 'flreal-part (eval `(lambda (x) (flreal-part x))) #:bad-value 1+2i)
(un 2 'imag-part 1+2i) (un 2 'imag-part 1+2i)
(un-exact 0 'imag-part 106) (un-exact 0 'imag-part 106)
(un-exact 0 'imag-part 106.0) (un-exact 0 'imag-part 106.0)
(un-exact 7.0 'flimag-part 10.0+7.0i #t) (un-exact 7.0 'flimag-part 10.0+7.0i #t)
(check-error-message 'flimag-part (eval `(lambda (x) (flimag-part x))) #:bad-value 1+2i)
(bin 1+2i 'make-rectangular 1 2) (bin 1+2i 'make-rectangular 1 2)
(bin-exact 1.0+2.0i 'make-rectangular 1 2.0) (bin-exact 1.0+2.0i 'make-rectangular 1 2.0)

1
src/racket/src/jitinline.c
View File

@ -1612,6 +1612,7 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
/* real part must always be inexact */ /* real part must always be inexact */
(void)jit_ldxi_p(JIT_R1, JIT_R0, &((Scheme_Complex *)0x0)->r); (void)jit_ldxi_p(JIT_R1, JIT_R0, &((Scheme_Complex *)0x0)->r);
CHECK_LIMIT(); CHECK_LIMIT();
(void)jit_bmsi_l(reffail, JIT_R1, 0x1);
(void)mz_bnei_t(reffail, JIT_R1, scheme_double_type, JIT_R2); (void)mz_bnei_t(reffail, JIT_R1, scheme_double_type, JIT_R2);
if (name[2] == 'i') { if (name[2] == 'i') {
(void)jit_ldxi_p(dest, JIT_R0, &((Scheme_Complex *)0x0)->i); (void)jit_ldxi_p(dest, JIT_R0, &((Scheme_Complex *)0x0)->i);

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

@ -1003,12 +1003,12 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("make-flrectangular", p, env); scheme_add_global_constant("make-flrectangular", p, env);
p = scheme_make_folding_prim(scheme_checked_real_part, "flreal-part", 1, 1, 1); p = scheme_make_folding_prim(scheme_checked_flreal_part, "flreal-part", 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_PRIM_PRODUCES_FLONUM); | SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flreal-part", p, env); scheme_add_global_constant("flreal-part", p, env);
p = scheme_make_folding_prim(scheme_checked_imag_part, "flimag-part", 1, 1, 1); p = scheme_make_folding_prim(scheme_checked_flimag_part, "flimag-part", 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_PRIM_PRODUCES_FLONUM); | SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flimag-part", p, env); scheme_add_global_constant("flimag-part", p, env);