From bc2cf531e3d0964d2068869d669f9b0ff5fba835 Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sun, 28 Jun 2015 08:59:44 -0300 Subject: [PATCH] Reduce variables with type null? and void? to null and # The optimizer reduces the variables with a known type to #t in a Boolean context. But some predicates imply that the variable has a definite values, so they can be reduced in a non-Boolean context too. For example, in (lambda (x) (if (null? x) x 0))) reduce the last x ==> null. --- .../tests/racket/optimize.rktl | 11 ++++++ racket/src/racket/src/fun.c | 10 +++--- racket/src/racket/src/optimize.c | 36 +++++++++++++++---- racket/src/racket/src/portfun.c | 10 +++--- racket/src/racket/src/schpriv.h | 2 ++ 5 files changed, 55 insertions(+), 14 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 6d63c4b603..b16f3a719d 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -1752,6 +1752,17 @@ (if r #t (something-else)))) '(lambda (x) (if (something) #t (something-else)))) +(let ([test-pred-implies-val + (lambda (pred? val) + (test-comp `(lambda (x) (if (,pred? x) ,val 0)) + `(lambda (x) (if (,pred? x) x 0))))]) + (test-pred-implies-val 'null? 'null) + (test-pred-implies-val 'void? '(void)) + (test-pred-implies-val 'eof-object? 'eof)) +(test-comp '(lambda (x) (if (null? x) 1 0) null) + '(lambda (x) (if (null? x) 1 0) x) + #f) + (test-comp '(lambda (x) (let ([r (something)]) (r))) '(lambda (x) ((something)))) diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 4e0a38994e..0fb41d6621 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -88,6 +88,7 @@ READ_ONLY Scheme_Object *scheme_values_func; /* the function bound to `values' * READ_ONLY Scheme_Object *scheme_procedure_p_proc; READ_ONLY Scheme_Object *scheme_procedure_arity_includes_proc; READ_ONLY Scheme_Object *scheme_void_proc; +READ_ONLY Scheme_Object *scheme_void_p_proc; READ_ONLY Scheme_Object *scheme_check_not_undefined_proc; READ_ONLY Scheme_Object *scheme_check_assign_not_undefined_proc; READ_ONLY Scheme_Object *scheme_apply_proc; @@ -507,10 +508,11 @@ scheme_init_fun (Scheme_Env *env) scheme_add_global_constant("void", scheme_void_proc, env); - o = scheme_make_folding_prim(void_p, "void?", 1, 1, 1); - SCHEME_PRIM_PROC_FLAGS(o) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED - | SCHEME_PRIM_IS_OMITABLE); - scheme_add_global_constant("void?", o, env); + REGISTER_SO(scheme_void_p_proc); + scheme_void_p_proc = scheme_make_folding_prim(void_p, "void?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(scheme_void_p_proc) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED + | SCHEME_PRIM_IS_OMITABLE); + scheme_add_global_constant("void?", scheme_void_p_proc, env); #ifdef TIME_SYNTAX scheme_add_global_constant("time-apply", diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index dbf4062ade..9a93f43d7a 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -2453,6 +2453,8 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc) else if (SAME_OBJ(rator, scheme_box_proc) || SAME_OBJ(rator, scheme_box_immutable_proc)) return scheme_box_p_proc; + else if (SAME_OBJ(rator, scheme_void_proc)) + return scheme_void_p_proc; { Scheme_Object *p; @@ -2566,6 +2568,17 @@ static Scheme_Object *expr_implies_predicate(Scheme_Object *expr, Optimize_Info if (SCHEME_INTP(expr) && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(expr))) return scheme_fixnum_p_proc; + + if (SCHEME_NULLP(expr)) + return scheme_null_p_proc; + if (SCHEME_PAIRP(expr)) + return scheme_pair_p_proc; + if (SCHEME_MPAIRP(expr)) + return scheme_mpair_p_proc; + if (SCHEME_VOIDP(expr)) + return scheme_void_p_proc; + if (SCHEME_EOFP(expr)) + return scheme_eof_object_p_proc; } if (rator) @@ -2806,7 +2819,7 @@ static void check_known(Optimize_Info *info, Scheme_Object *app, /* Replace the rator with an unsafe version if we know that it's ok. Alternatively, the rator implies a check, so add type information for subsequent expressions. If the rand has alredy a different type, mark that this will generate an error. - If unsafe is NULL then rator has no unsafe vesion, so only check the type. */ + If unsafe is NULL then rator has no unsafe version, so only check the type. */ { if (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, who)) { Scheme_Object *pred; @@ -4007,6 +4020,8 @@ static int relevant_predicate(Scheme_Object *pred) || SAME_OBJ(pred, scheme_fixnum_p_proc) || SAME_OBJ(pred, scheme_flonum_p_proc) || SAME_OBJ(pred, scheme_extflonum_p_proc) + || SAME_OBJ(pred, scheme_void_p_proc) + || SAME_OBJ(pred, scheme_eof_object_p_proc) ); } @@ -7401,18 +7416,27 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in delta = optimize_info_get_shift(info, pos); - if ((context & OPT_CONTEXT_BOOLEAN) - && !optimize_is_mutated(info, pos + delta)) { + if (!optimize_is_mutated(info, pos + delta)) { Scheme_Object *pred; + pred = optimize_get_predicate(pos + delta, info); if (pred) { - /* all predicates recognize non-#f things */ - return scheme_true; + if (context & OPT_CONTEXT_BOOLEAN) { + /* all predicates recognize non-#f things */ + return scheme_true; + } + + if (SAME_OBJ(pred, scheme_null_p_proc)) + return scheme_null; + if (SAME_OBJ(pred, scheme_void_p_proc)) + return scheme_void; + if (SAME_OBJ(pred, scheme_eof_object_p_proc)) + return scheme_eof; } } if (delta) - expr = scheme_make_local(scheme_local_type, pos + delta, 0); + expr = scheme_make_local(scheme_local_type, pos + delta, 0); return expr; } diff --git a/racket/src/racket/src/portfun.c b/racket/src/racket/src/portfun.c index 42083c37be..c46d335260 100644 --- a/racket/src/racket/src/portfun.c +++ b/racket/src/racket/src/portfun.c @@ -158,6 +158,7 @@ READ_ONLY static Scheme_Object *default_display_handler; READ_ONLY static Scheme_Object *default_write_handler; READ_ONLY static Scheme_Object *default_print_handler; +READ_ONLY Scheme_Object *scheme_eof_object_p_proc; READ_ONLY Scheme_Object *scheme_default_global_print_handler; READ_ONLY Scheme_Object *scheme_write_proc; @@ -335,10 +336,11 @@ scheme_init_port_fun(Scheme_Env *env) GLOBAL_NONCM_PRIM("port-count-lines!", port_count_lines, 1, 1, env); GLOBAL_NONCM_PRIM("port-counts-lines?", port_counts_lines_p, 1, 1, env); - p = scheme_make_folding_prim(eof_object_p, "eof-object?", 1, 1, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED - | SCHEME_PRIM_IS_OMITABLE); - scheme_add_global_constant("eof-object?", p, env); + REGISTER_SO(scheme_eof_object_p_proc); + scheme_eof_object_p_proc = scheme_make_folding_prim(eof_object_p, "eof-object?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(scheme_eof_object_p_proc) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED + | SCHEME_PRIM_IS_OMITABLE); + scheme_add_global_constant("eof-object?", scheme_eof_object_p_proc, env); scheme_add_global_constant("write", scheme_write_proc, env); scheme_add_global_constant("display", scheme_display_proc, env); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index a27a430e35..65a9f47bb8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -439,6 +439,7 @@ extern Scheme_Object *scheme_values_func; extern Scheme_Object *scheme_procedure_p_proc; extern Scheme_Object *scheme_procedure_arity_includes_proc; extern Scheme_Object *scheme_void_proc; +extern Scheme_Object *scheme_void_p_proc; extern Scheme_Object *scheme_syntax_p_proc; extern Scheme_Object *scheme_check_not_undefined_proc; extern Scheme_Object *scheme_check_assign_not_undefined_proc; @@ -2445,6 +2446,7 @@ Scheme_Object *scheme_default_prompt_read_handler(int, Scheme_Object *[]); Scheme_Object *scheme_default_read_input_port_handler(int argc, Scheme_Object *[]); Scheme_Object *scheme_default_read_handler(int argc, Scheme_Object *[]); +extern Scheme_Object *scheme_eof_object_p_proc; extern Scheme_Object *scheme_default_global_print_handler; /* Type readers & writers for compiled code data */