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

Make dead code elimination work for non case lambdas.

Browse Source 
Related to PR14138.

original commit: dd01d9932d2c809d14c17c6973fb41fd87eb2b63
This commit is contained in:
Eric Dobson 2013-11-06 21:14:58 -08:00
parent 774f32dad3
commit 029e55dead
4 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt
View File

@ -37,9 +37,12 @@
(pattern ((~and kw if) tst:contradiction thn:expr els:opt-expr)
#:do [(log-optimization "dead then branch" "Unreachable then branch elimination." #'thn)]
#:with opt (syntax/loc/origin this-syntax #'kw (if tst.opt thn els.opt)))
(pattern ((~and kw lambda) formals . bodies)
#:when (dead-lambda-branch? #'formals)
#:with opt this-syntax)
(pattern ((~and kw case-lambda) (formals . bodies) ...)
#:when (for/or ((formals (in-syntax #'(formals ...))))
(dead-case-lambda-branch? formals))
(dead-lambda-branch? formals))
#:with opt
(quasisyntax/loc/origin
this-syntax #'kw
@ -47,13 +50,13 @@
(case-lambda
#,@(for/list ((formals (in-syntax #'(formals ...)))
(bodies (in-syntax #'(bodies ...)))
#:unless (dead-case-lambda-branch? formals))
#:unless (dead-lambda-branch? formals))
(cons formals (stx-map (optimize) bodies))))
;; We need to keep the syntax objects around in the generated code with the correct bindings
;; so that CheckSyntax displays the arrows correctly
#,@(for/list ((formals (in-syntax #'(formals ...)))
(bodies (in-syntax #'(bodies ...)))
#:when (dead-case-lambda-branch? formals))
#:when (dead-lambda-branch? formals))
(log-optimization
"dead case-lambda branch"
"Unreachable case-lambda branch elimination."

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
View File

@ -334,7 +334,7 @@
[(or (arities-seen-seen-before? arities-seen arity)
(and expected-type (null? (find-matching-arities formal))))
(warn-unreachable body)
(add-dead-case-lambda-branch (formals-syntax formal))
(add-dead-lambda-branch (formals-syntax formal))
(if (check-unreachable-code?)
(cons formal+body formals+bodies*)
formals+bodies*)]

16
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt
View File

@ -56,16 +56,16 @@
(eq? t? (hash-ref tautology-contradiction-table e 'not-there)))
(values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
;; keeps track of case-lambda branches that never get evaluated, so that the
;; keeps track of lambda branches that never get evaluated, so that the
;; optimizer can eliminate dead code. The key is the formals syntax object.
;; 1 possible value: #t
(define case-lambda-dead-table (make-hasheq))
(define lambda-dead-table (make-hasheq))
(define (add-dead-case-lambda-branch formals)
(define (add-dead-lambda-branch formals)
(when (optimize?)
(hash-set! case-lambda-dead-table formals #t)))
(define (dead-case-lambda-branch? formals)
(hash-ref case-lambda-dead-table formals #f))
(hash-set! lambda-dead-table formals #t)))
(define (dead-lambda-branch? formals)
(hash-ref lambda-dead-table formals #f))
(provide/cond-contract
@ -78,5 +78,5 @@
[tautology? (syntax? . -> . boolean?)]
[contradiction? (syntax? . -> . boolean?)]
[neither? (syntax? . -> . boolean?)]
[add-dead-case-lambda-branch (syntax? . -> . any)]
[dead-case-lambda-branch? (syntax? . -> . boolean?)])
[add-dead-lambda-branch (syntax? . -> . any)]
[dead-lambda-branch? (syntax? . -> . boolean?)])

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14138.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang typed/racket
(: f (case->))
(define (f x) (add1 "foo"))