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

bytecode optimizer: remove exact->inexact on known flonum

Browse Source 
And similar for `real->double-flonum`. Also, convert those to
`unsafe-fx->fl` when the argument is known to be a fixnum.
This commit is contained in:
Matthew Flatt 2019-06-05 10:40:53 -06:00
parent 3b4cff1bfd
commit a72220a3ac
4 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -610,6 +610,17 @@
(test-comp '(lambda (z) (let ([f (lambda (i) (car i))]) (f z)) #t)
'(lambda (z) (let ([f (lambda (i) (car i))]) (f z)) (pair? z)))
(test-comp '(lambda (z) (fl+ z z))
'(lambda (z) (real->double-flonum (fl+ z z))))
(test-comp '(lambda (z) (fl+ z z))
'(lambda (z) (exact->inexact (fl+ z z))))
(test-comp '(lambda (z) (real->double-flonum z))
'(lambda (z) (real->double-flonum (real->double-flonum z))))
(test-comp '(lambda (z) (unsafe-fx->fl (fx+ z z)))
'(lambda (z) (real->double-flonum (fx+ z z))))
(test-comp '(lambda (z) (unsafe-fx->fl (fx+ z z)))
'(lambda (z) (exact->inexact (fx+ z z))))
; Test that the optimizer infers correctly the type of all the arguments
; and the type of the return value. Use #f in case the type is unknown.
(define (test-arg-types proc/args? val?

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

@ -211,6 +211,7 @@ READ_ONLY Scheme_Object *scheme_unsafe_fxand_proc;
READ_ONLY Scheme_Object *scheme_unsafe_fxior_proc;
READ_ONLY Scheme_Object *scheme_unsafe_fxxor_proc;
READ_ONLY Scheme_Object *scheme_unsafe_fxrshift_proc;
READ_ONLY Scheme_Object *scheme_unsafe_fx_to_fl_proc;
READ_ONLY double scheme_infinity_val;
READ_ONLY double scheme_minus_infinity_val;
@ -536,6 +537,8 @@ scheme_init_number (Scheme_Startup_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
flags |= (SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_AD_HOC_OPT);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
scheme_addto_prim_instance("real->double-flonum", p, env);
@ -735,6 +738,7 @@ scheme_init_number (Scheme_Startup_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
flags |= SCHEME_PRIM_AD_HOC_OPT;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
scheme_addto_prim_instance("exact->inexact", p, env);
@ -1370,6 +1374,8 @@ void scheme_init_unsafe_number(Scheme_Startup_Env *env)
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_addto_prim_instance("unsafe-fx->fl", p, env);
REGISTER_SO(scheme_unsafe_fx_to_fl_proc);
scheme_unsafe_fx_to_fl_proc = p;
p = scheme_make_folding_prim(unsafe_fl_to_fx, "unsafe-fl->fx", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED

12
racket/src/racket/src/optimize.c
View File

@ -4586,7 +4586,7 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
&& !strcmp(SCHEME_SYM_VAL(rand), "vm")) {
/* For the expander's benefit, optimize `(system-type 'vm)` to `'racket`
to effectively select backend details statically. */
return scheme_intern_symbol("racket");
return replace_tail_inside(scheme_intern_symbol("racket"), inside, app->rand);
}
{
@ -4630,6 +4630,16 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
check_known(info, app_o, rator, rand, "keyword->string", scheme_keyword_p_proc, scheme_true, info->unsafe_mode);
check_known(info, app_o, rator, rand, "char->integer", scheme_char_p_proc, scheme_unsafe_char_to_integer_proc, info->unsafe_mode);
if (IS_NAMED_PRIM(rator, "real->double-flonum")
|| IS_NAMED_PRIM(rator, "exact->inexact")) {
Scheme_Object *pred;
pred = expr_implies_predicate(rand, info);
if (predicate_implies(pred, scheme_flonum_p_proc))
return replace_tail_inside(rand, inside, rand);
else if (predicate_implies(pred, scheme_fixnum_p_proc))
reset_rator(app_o, scheme_unsafe_fx_to_fl_proc);
}
}
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL)

1
racket/src/racket/src/schpriv.h
View File

@ -591,6 +591,7 @@ extern Scheme_Object *scheme_unsafe_fxand_proc;
extern Scheme_Object *scheme_unsafe_fxior_proc;
extern Scheme_Object *scheme_unsafe_fxxor_proc;
extern Scheme_Object *scheme_unsafe_fxrshift_proc;
extern Scheme_Object *scheme_unsafe_fx_to_fl_proc;
extern Scheme_Object *scheme_unsafe_pure_proc;
extern Scheme_Object *scheme_string_p_proc;