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

optimizer: don't discard potential hash errors

Browse Source 
If `hasheq` is given an odd number of arguments or if `make-hasheq` is
given a bad argument, then the error should be preserved.

Related to #2685
This commit is contained in:
Matthew Flatt 2019-06-08 11:33:21 -06:00
parent 2cd3679d8b
commit 34cd1e2a2b
6 changed files with 125 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3291,6 +3291,45 @@
'UNEXPECTED!))
#f)
(let ()
(define (check-empty-allocation hash-sym)
(test-comp `(lambda () (,hash-sym) 5)
'(lambda () 5))
(test-comp `(lambda (x) (,hash-sym x) 5) ; x may not have the right shape
'(lambda (x) 5)
#f))
(check-empty-allocation 'hash)
(check-empty-allocation 'hasheqv)
(check-empty-allocation 'hasheq)
(check-empty-allocation 'make-hash)
(check-empty-allocation 'make-hasheqv)
(check-empty-allocation 'make-hasheq)
(check-empty-allocation 'make-weak-hash)
(check-empty-allocation 'make-weak-hasheqv)
(check-empty-allocation 'make-weak-hasheq)
(check-empty-allocation 'make-immutable-hash)
(check-empty-allocation 'make-immutable-hasheqv)
(check-empty-allocation 'make-immutable-hasheq)
(test-comp `(lambda (x y) (hash x y) 5) ; can trigger equal callbacks
'(lambda () 5)
#f)
(test-comp `(lambda (x y) (hasheqv x y) 5)
'(lambda (x y) 5))
(test-comp `(lambda (x y) (hasheq x y) 5)
'(lambda (x y) 5))
;; Wrong arity
(test-comp `(lambda (x y) (hash x) 5)
'(lambda (x) 5)
#f)
(test-comp `(lambda (x) (hasheqv x) 5)
'(lambda (x) 5)
#f)
(test-comp `(lambda (x) (hasheq x) 5)
'(lambda (x) 5)
#f))
;; Check elimination of ignored structure predicate
;; and constructor applications:

11
racket/src/racket/src/letrec_check.c
View File

@ -411,10 +411,9 @@ static Scheme_Object *letrec_check_local(Scheme_Object *o, Letrec_Check_Frame *f
return o;
}
static int is_effect_free_prim(Scheme_Object *rator)
static int is_effect_free_prim(Scheme_Object *rator, int argc)
{
if (SCHEME_PRIMP(rator)
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_OMITABLE_ANY))
if (SCHEME_PRIMP(rator) && scheme_is_omitable_primitive(rator, argc))
return 1;
return 0;
@ -431,7 +430,7 @@ static Scheme_Object *letrec_check_application(Scheme_Object *o, Letrec_Check_Fr
/* we'll have to check the rator and all the arguments */
n = 1 + app->num_args;
if (is_effect_free_prim(app->args[0])) {
if (is_effect_free_prim(app->args[0], app->num_args)) {
/* an immediate prim cannot call anything among its arguments */
} else {
/* argument might get applied */
@ -453,7 +452,7 @@ static Scheme_Object *letrec_check_application2(Scheme_Object *o, Letrec_Check_F
app = (Scheme_App2_Rec *)o;
if (is_effect_free_prim(app->rator)) {
if (is_effect_free_prim(app->rator, 1)) {
/* an immediate prim cannot call anything among its arguments */
} else {
/* argument might get applied */
@ -475,7 +474,7 @@ static Scheme_Object *letrec_check_application3(Scheme_Object *o, Letrec_Check_F
app = (Scheme_App3_Rec *)o;
if (is_effect_free_prim(app->rator)) {
if (is_effect_free_prim(app->rator, 2)) {
/* an immediate prim cannot call anything among its arguments */
} else {
/* argument might get applied */

7
racket/src/racket/src/linklet.c
View File

@ -295,9 +295,10 @@ static Scheme_Object *primitive_in_category_p(int argc, Scheme_Object **argv)
else if (SAME_OBJ(cat, folding_symbol))
r = (opt >= SCHEME_PRIM_OPT_FOLDING);
else if (SAME_OBJ(cat, omitable_symbol))
r = (SCHEME_PRIM_PROC_OPT_FLAGS(v) & (SCHEME_PRIM_IS_OMITABLE_ANY
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_IS_UNSAFE_OMITABLE));
r = (SCHEME_PRIM_PROC_OPT_FLAGS(v) & (SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL));
else
r = 0;
} else

25
racket/src/racket/src/list.c
View File

@ -536,57 +536,58 @@ scheme_init_list (Scheme_Startup_Env *env)
p = scheme_make_immed_prim(make_hash, "make-hash", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-hash", p, env);
p = scheme_make_immed_prim(make_hasheq, "make-hasheq", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-hasheq", p, env);
p = scheme_make_immed_prim(make_hasheqv, "make-hasheqv", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-hasheqv", p, env);
p = scheme_make_immed_prim(make_weak_hash, "make-weak-hash", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-weak-hash", p, env);
p = scheme_make_immed_prim(make_weak_hasheq, "make-weak-hasheq", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-weak-hasheq", p, env);
p = scheme_make_immed_prim(make_weak_hasheqv, "make-weak-hasheqv", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-weak-hasheqv", p, env);
p = scheme_make_immed_prim(scheme_make_immutable_hash, "make-immutable-hash", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-immutable-hash", p, env);
p = scheme_make_immed_prim(scheme_make_immutable_hasheq, "make-immutable-hasheq", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-immutable-hasheq", p, env);
p = scheme_make_immed_prim(scheme_make_immutable_hasheqv, "make-immutable-hasheqv", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-immutable-hasheqv", p, env);
REGISTER_SO(scheme_hash_proc);
p = scheme_make_immed_prim(direct_hash, "hash", 0, -1);
scheme_hash_proc = p;
/* not SCHEME_PRIM_IS_OMITABLE_ALLOCATION, because `equal?`-hashing functions are called */
/* not SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION, because `equal?`-hashing functions are called */
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("hash", p, env);
REGISTER_SO(scheme_hasheq_proc);
p = scheme_make_immed_prim(direct_hasheq, "hasheq", 0, -1);
scheme_hasheq_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("hasheq", p, env);
REGISTER_SO(scheme_hasheqv_proc);
p = scheme_make_immed_prim(direct_hasheqv, "hasheqv", 0, -1);
scheme_hasheqv_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("hasheqv", p, env);
p = scheme_make_folding_prim(hash_p, "hash?", 1, 1, 1);

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

@ -120,7 +120,7 @@ static int lambda_has_top_level(Scheme_Lambda *lam);
static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b);
static int wants_local_type_arguments(Scheme_Object *rator, int argpos);
XFORM_NONGCING static int wants_local_type_arguments(Scheme_Object *rator, int argpos);
static void add_types_for_f_branch(Scheme_Object *t, Optimize_Info *info, int fuel);
@ -357,7 +357,8 @@ int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args
Return 2 => true, and results are a constant when arguments are constants. */
{
if (SCHEME_PRIMP(rator)
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ANY | SCHEME_PRIM_IS_UNSAFE_NONMUTATING))
&& ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONMUTATING)
|| scheme_is_omitable_primitive(rator, num_args))
&& (num_args >= ((Scheme_Primitive_Proc *)rator)->mina)
&& (num_args <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)
&& ((expected_vals < 0)
@ -371,6 +372,24 @@ int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args
return 0;
}
int scheme_is_omitable_primitive(Scheme_Object *rator, int num_args)
{
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_UNSAFE_OMITABLE))
return 1;
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION)
return (num_args == 0);
if ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION))
return !(num_args & 0x1);
return 0;
}
int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals);
static Scheme_Object *get_defn_shape(Optimize_Info *info, Scheme_IR_Toplevel *var)
{
Scheme_Object *v;
@ -3127,31 +3146,34 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat
return optimize_expr(orig_rator, info, context);
}
static int is_nonmutating_nondependant_primitive(Scheme_Object *rator, int n)
XFORM_NONGCING static int is_primitive_allocating(Scheme_Object *rator, int argc)
{
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION))
return scheme_is_omitable_primitive(rator, argc);
return 0;
}
XFORM_NONGCING static int is_nonmutating_nondependant_primitive(Scheme_Object *rator, int argc)
/* Does not include SCHEME_PRIM_IS_UNSAFE_OMITABLE, because those can
depend on earlier tests (explicit or implicit) for whether the
unsafe operation is defined */
{
if (SCHEME_PRIMP(rator)
&& ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE_ALLOCATION))
&& (((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_OMITABLE)
|| is_primitive_allocating(rator, argc))
&& !(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_UNSAFE_OMITABLE))
&& !((SAME_OBJ(scheme_values_proc, rator) && (n != 1))))
&& (n >= ((Scheme_Primitive_Proc *)rator)->mina)
&& (n <= ((Scheme_Primitive_Proc *)rator)->mu.maxa))
&& !((SAME_OBJ(scheme_values_proc, rator) && (argc != 1))))
&& (argc >= ((Scheme_Primitive_Proc *)rator)->mina)
&& (argc <= ((Scheme_Primitive_Proc *)rator)->mu.maxa))
return 1;
return 0;
}
static int is_primitive_allocating(Scheme_Object *rator, int n)
{
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ALLOCATION))
return 1;
return 0;
}
static int is_noncapturing_primitive(Scheme_Object *rator, int n)
XFORM_NONGCING static int is_noncapturing_primitive(Scheme_Object *rator, int n)
{
if (SCHEME_PRIMP(rator)) {
int opt, t;
@ -3174,7 +3196,7 @@ static int is_noncapturing_primitive(Scheme_Object *rator, int n)
return 0;
}
static int is_nonsaving_primitive(Scheme_Object *rator, int n)
XFORM_NONGCING static int is_nonsaving_primitive(Scheme_Object *rator, int n)
{
if (SCHEME_PRIMP(rator)) {
int opt;
@ -3188,7 +3210,7 @@ static int is_nonsaving_primitive(Scheme_Object *rator, int n)
return 0;
}
static int is_always_escaping_primitive(Scheme_Object *rator)
XFORM_NONGCING static int is_always_escaping_primitive(Scheme_Object *rator)
{
if (SCHEME_PRIMP(rator)
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES)) {
@ -3199,7 +3221,7 @@ static int is_always_escaping_primitive(Scheme_Object *rator)
#define IS_NAMED_PRIM(p, nm) (!strcmp(((Scheme_Primitive_Proc *)p)->name, nm))
static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
XFORM_NONGCING static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
{
if (SCHEME_PRIMP(rator)) {
int flags;

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

@ -77,51 +77,51 @@
/* indicates that a primitive call can be dropped, but it allocates,
so it's not as reorderable as it might be otherwise: */
#define SCHEME_PRIM_IS_OMITABLE_ALLOCATION (1 << 5)
#define SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION (1 << 6)
#define SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION (1 << 7)
/* indicates that a primitive call will produce the same results for the same
inputs; note that UNSAFE_FUNCTIONAL is stronger than UNSAFE_OMITABLE: */
#define SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL (1 << 6)
#define SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL (1 << 8)
/* the SCHEME_PRIMT_WANTS_... flags indicate a primitive that
expects certain kinds of arguments and can encourage unboxing: */
#define SCHEME_PRIM_WANTS_FLONUM_FIRST (1 << 7)
#define SCHEME_PRIM_WANTS_FLONUM_SECOND (1 << 8)
#define SCHEME_PRIM_WANTS_FLONUM_THIRD (1 << 9)
#define SCHEME_PRIM_WANTS_EXTFLONUM_FIRST (1 << 10)
#define SCHEME_PRIM_WANTS_EXTFLONUM_SECOND (1 << 11)
#define SCHEME_PRIM_WANTS_EXTFLONUM_THIRD (1 << 12)
#define SCHEME_PRIM_WANTS_FLONUM_FIRST (1 << 9)
#define SCHEME_PRIM_WANTS_FLONUM_SECOND (1 << 10)
#define SCHEME_PRIM_WANTS_FLONUM_THIRD (1 << 11)
#define SCHEME_PRIM_WANTS_EXTFLONUM_FIRST (1 << 12)
#define SCHEME_PRIM_WANTS_EXTFLONUM_SECOND (1 << 13)
#define SCHEME_PRIM_WANTS_EXTFLONUM_THIRD (1 << 14)
/* indicates an unsafe operation that does not allocate: */
#define SCHEME_PRIM_IS_UNSAFE_NONALLOCATE (1 << 13)
#define SCHEME_PRIM_IS_UNSAFE_NONALLOCATE (1 << 15)
/* indicates a primitive that always raises an exception or
otherwise escapes from the current continuation: */
#define SCHEME_PRIM_ALWAYS_ESCAPES (1 << 14)
#define SCHEME_PRIM_ALWAYS_ESCAPES (1 << 16)
/* indicates a primitive that is JIT-inlined on some platforms,
but not the current one: */
#define SCHEME_PRIM_SOMETIMES_INLINED (1 << 15)
#define SCHEME_PRIM_SOMETIMES_INLINED (1 << 17)
/* indicates a primitive that produces a real or number (or
errors): */
#define SCHEME_PRIM_PRODUCES_REAL (1 << 16)
#define SCHEME_PRIM_PRODUCES_NUMBER (1 << 17)
#define SCHEME_PRIM_PRODUCES_REAL (1 << 18)
#define SCHEME_PRIM_PRODUCES_NUMBER (1 << 19)
/* indicates a primitive that requires certain argument types (all the
same type): */
#define SCHEME_PRIM_WANTS_REAL (1 << 18)
#define SCHEME_PRIM_WANTS_NUMBER (1 << 19)
#define SCHEME_PRIM_WANTS_REAL (1 << 20)
#define SCHEME_PRIM_WANTS_NUMBER (1 << 21)
/* indicates a primitive that always succeed when given
arguments of the expected type: */
#define SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS (1 << 20)
#define SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS (1 << 22)
/* indicates a primitive that produces a real number when
given real-number arguments: */
#define SCHEME_PRIM_CLOSED_ON_REALS (1 << 21)
#define SCHEME_PRIM_CLOSED_ON_REALS (1 << 23)
/* indicates the presence of an ad-hoc optimization
in one of the application optimization passes */
#define SCHEME_PRIM_AD_HOC_OPT (1 << 22)
#define SCHEME_PRIM_AD_HOC_OPT (1 << 24)
/* a primitive that produces a booeal or errors: */
#define SCHEME_PRIM_PRODUCES_BOOL (1 << 23)
#define SCHEME_PRIM_PRODUCES_BOOL (1 << 25)
#define SCHEME_PRIM_OPT_TYPE_SHIFT 24
#define SCHEME_PRIM_OPT_TYPE_SHIFT 26
#define SCHEME_PRIM_OPT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_OPT_TYPE(x) ((x & SCHEME_PRIM_OPT_TYPE_MASK) >> SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_IS_OMITABLE_ANY (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE_ALLOCATION | SCHEME_PRIM_IS_UNSAFE_OMITABLE)
#define SCHEME_PRIM_PRODUCES_FLONUM (SCHEME_LOCAL_TYPE_FLONUM << SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_PRODUCES_FIXNUM (SCHEME_LOCAL_TYPE_FIXNUM << SCHEME_PRIM_OPT_TYPE_SHIFT)
@ -3061,7 +3061,8 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags,
int scheme_might_invoke_call_cc(Scheme_Object *value);
int scheme_is_liftable(Scheme_Object *o, Scheme_Hash_Tree *exclude_vars, int fuel, int as_rator, int or_escape);
int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals);
XFORM_NONGCING int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals);
XFORM_NONGCING int scheme_is_omitable_primitive(Scheme_Object *rator, int num_args);
typedef struct {
int uses_super;