Drop some trivially-pure code.
original commit: a497300fbe2b7fff390cbb3707e23b968b3826a1
This commit is contained in:
parent
109fa43722
commit
4c8e90b8ac
|
@ -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)))
|
||||
|
|
@ -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)))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user