diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt index 5fd3ad94..e243b3e4 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt @@ -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." diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt index b1a6c740..5cb58460 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt @@ -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*)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt index 9d7cf9d4..0f79e2d0 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt @@ -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?)]) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14138.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14138.rkt new file mode 100644 index 00000000..7dba4c4a --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14138.rkt @@ -0,0 +1,3 @@ +#lang typed/racket +(: f (case->)) +(define (f x) (add1 "foo"))