Drop some trivially-pure code.

original commit: a497300fbe2b7fff390cbb3707e23b968b3826a1
This commit is contained in:
Sam Tobin-Hochstadt 2011-12-06 09:42:40 -05:00
parent 109fa43722
commit 4c8e90b8ac
2 changed files with 42 additions and 3 deletions

View File

@ -0,0 +1,16 @@
#;
(
TR opt: drop-pure-pred.rkt 13:6 (exact-integer? x) -- useless pure code
TR opt: drop-pure-pred.rkt 15:6 (list 2) -- dead else branch
'(1)
)
#lang typed/scheme
#:optimize
(let ()
(define x 7)
(if (exact-integer? x)
(list 1)
(list 2)))

View File

@ -1,13 +1,36 @@
#lang scheme/base
(require syntax/parse
(for-template scheme/base)
(for-template scheme/base racket/flonum racket/fixnum)
"../utils/utils.rkt"
(types type-table)
(utils tc-utils)
(optimizer utils logging))
(provide dead-code-opt-expr)
(define-syntax-class predicate
#:literals (flvector? fxvector? exact-integer? fixnum? flonum? vector? string? bytes?)
[pattern (~and x:id (~or flvector? exact-integer? fixnum? flonum? vector? fxvector?))])
(define (pure? stx)
(syntax-parse stx
#:literals (#%plain-app)
[(#%plain-app f:predicate x:id)
#:when (eq? 'lexical (identifier-binding #'x))
(add-disappeared-use #'f)
(add-disappeared-use #'x)
#true]
[else #false]))
(define (optimize/drop-pure stx)
(cond [(pure? stx)
(log-optimization "useless pure code"
"Unreachable pure code elimination."
stx)
(syntax/loc stx (void))]
[else ((optimize) stx)]))
(define-syntax-class dead-code-opt-expr
#:commit
;; if one of the brances of an if is unreachable, we can eliminate it
@ -20,7 +43,7 @@
#'els)
(quasisyntax/loc/origin
this-syntax #'kw
(#%expression (begin #,((optimize) #'tst)
(#%expression (begin #,(optimize/drop-pure #'tst)
#,((optimize) #'thn))))))
(pattern ((~and kw (~literal if)) tst:expr thn:expr els:expr)
#:when (contradiction? #'tst)
@ -30,5 +53,5 @@
#'thn)
(quasisyntax/loc/origin
this-syntax #'kw
(#%expression (begin #,((optimize) #'tst)
(#%expression (begin #,(optimize/drop-pure #'tst)
#,((optimize) #'els)))))))