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

bc: don't drop operations when impersonators can interpose

Browse Source 
For example, if the result of `(when (box? x) (unbox x))` is not used,
then the `(unbox x)` still must be done, because the box might be an
impersonator. In contrast, `(when (box*? x) (unbox* x))` can be
dropped, since `unbox*` is an authentic unbox.

This change applies to unsafe operations like `unsafe-struct-ref`,
too, and applies to struct accessors for non-authentic structure
types.

Racket CS already preserves operations appropriately.

Relevant to #3487
This commit is contained in:
Matthew Flatt 2020-11-07 10:32:11 -07:00
parent 1149bb8b2c
commit 09c9901f6b
3 changed files with 45 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3213,13 +3213,10 @@
(displayln (list expr 3 '!))
)
(map check-omit-ok
'((unsafe-vector-ref x y)
(unsafe-vector*-ref x y)
(unsafe-struct-ref x y)
'((unsafe-vector*-ref x y)
(unsafe-struct*-ref x y)
(unsafe-mcar x)
(unsafe-mcdr x)
(unsafe-unbox y)
(unsafe-unbox* x)
(unsafe-bytes-ref x y)
(unsafe-string-ref x y)
@ -3229,12 +3226,15 @@
(unsafe-s16vector-ref x y)
(unsafe-u16vector-ref x y)))
(map (lambda (x) (check-omit-ok x #f))
'((unsafe-vector-set! x y z)
'((unsafe-vector-ref x y)
(unsafe-struct-ref x y)
(unsafe-vector-set! x y z)
(unsafe-vector*-set! x y z)
(unsafe-struct-set! x y z)
(unsafe-struct*-set! x y z)
(unsafe-set-mcar! x y)
(unsafe-set-mcdr! x y)
(unsafe-unbox y)
(unsafe-set-box! x y)
(unsafe-set-box*! x y)
(unsafe-bytes-set! x y z)
@ -3680,7 +3680,6 @@
(procedure? a-x)
(lambda (x) (values (a-x x)))
(lambda (x) (when (a? x) (void (a-x x))))
(procedure? set-a-x!)
(lambda (x) (values (set-a-x! x 5))))
@ -3697,6 +3696,44 @@
(lambda (x) a #t)
(lambda (x) (when (a? x) #t))
#t
(lambda (x) (a-x x))
#t
(lambda (x) (set-a-x! x 5))))
(test-comp '(module m racket/base
(struct a (x) #:omit-define-syntaxes #:mutable #:authentic)
(procedure? a)
(lambda (x) (values (a x)))
(lambda (x) (void (a x)))
(procedure? a?)
(lambda (x) (values (a? x)))
(lambda (x) (void (a? x)))
(lambda (x) (boolean? (a? x)))
(lambda (x) (when (a? x) (a? x)))
(procedure? a-x)
(lambda (x) (values (a-x x)))
(lambda (x) (when (a? x) (void (a-x x))))
(procedure? set-a-x!)
(lambda (x) (values (set-a-x! x 5))))
'(module m racket/base
(struct a (x) #:omit-define-syntaxes #:mutable #:authentic)
#t
(lambda (x) (a x))
(lambda (x) a (void))
#t
(lambda (x) (a? x))
(lambda (x) a (void))
(lambda (x) a #t)
(lambda (x) (when (a? x) #t))
#t
(lambda (x) (a-x x))
(lambda (x) (when (a? x) (void)))

2
racket/src/bc/src/list.c
View File

@ -916,8 +916,6 @@ scheme_init_unsafe_list (Scheme_Startup_Env *env)
REGISTER_SO(scheme_unsafe_unbox_proc);
p = scheme_make_immed_prim(unsafe_unbox, "unsafe-unbox", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_AD_HOC_OPT);
scheme_addto_prim_instance("unsafe-unbox", p, env);
scheme_unsafe_unbox_proc = p;

8
racket/src/bc/src/vector.c
View File

@ -250,9 +250,7 @@ scheme_init_unsafe_vector (Scheme_Startup_Env *env)
scheme_unsafe_vector_star_length_proc = p;
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_addto_prim_instance("unsafe-vector-ref", p, env);
REGISTER_SO(scheme_unsafe_vector_star_ref_proc);
@ -280,9 +278,7 @@ scheme_init_unsafe_vector (Scheme_Startup_Env *env)
REGISTER_SO(scheme_unsafe_struct_ref_proc);
p = scheme_make_immed_prim(unsafe_struct_ref, "unsafe-struct-ref", 2, 2);
scheme_unsafe_struct_ref_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_addto_prim_instance("unsafe-struct-ref", p, env);
REGISTER_SO(scheme_unsafe_struct_ref_proc);