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

optimizer: recognize that arguments to void are ignored

Browse Source
This commit is contained in:
Matthew Flatt 2014-06-19 13:57:38 +01:00
parent 780a825d34
commit 92f76764c7
2 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

@ -1237,6 +1237,9 @@
'(lambda (a b)
(not (if a b #t))))
(test-comp '(lambda (w) (if (void (list w)) 1 2))
'(lambda (w) 1))
;; Ok to move `box' past a side effect (that can't capture a
;; resumable continuation):
(test-comp '(let ([h (box 0.0)])
@ -3191,14 +3194,14 @@
(let ()
(define c1
'(module c1 racket/base
(void ((if (zero? (random 1))
(lambda (f) (displayln (f)))
#f)
(lambda ()
;; This access of i should raise an exception:
i)))
(define i (random 1))))
'(module c1 racket/kernel
((if (zero? (random 1))
(lambda (f) (display (f)))
#f)
(lambda ()
;; This access of i should raise an exception:
i))
(define-values (i) (random 1))))
(define o (open-output-bytes))
@ -3223,20 +3226,15 @@
[(list a b)
(list (match a
[(application rator (list rand))
(application
(application
rator
(list
(match rand
[(application rator (list rand))
(application
rator
(list
(struct-copy
lam rand
[body
(match (lam-body rand)
[(toplevel depth pos const? ready?)
(toplevel depth pos #t #t)])])))])))])
(struct-copy
lam rand
[body
(match (lam-body rand)
[(toplevel depth pos const? ready?)
(toplevel depth pos #t #t)])])))])
b)])])))]))
o2))

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

@ -2546,6 +2546,9 @@ static Scheme_Object *finish_optimize_any_application(Scheme_Object *app, Scheme
if (rator_implies_predicate(rator, argc))
return make_discarding_sequence(app, scheme_true, info);
if (SAME_OBJ(rator, scheme_void_proc))
return make_discarding_sequence(app, scheme_void, info);
return app;
}