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

Reduce variables with type null? and void? to null and #<void>

Browse Source 
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.
This commit is contained in:
Gustavo Massaccesi 2015-06-28 08:59:44 -03:00
parent 58300857db
commit bc2cf531e3
5 changed files with 55 additions and 14 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

@ -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))))

10
racket/src/racket/src/fun.c
View File

@ -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",

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

@ -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;
}

10
racket/src/racket/src/portfun.c
View File

@ -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);

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

@ -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 */