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

Keep dead case-lambda clauses around to avoid changing arity.

Browse Source 
Closes PR14468.

original commit: ce3033a0c7e0c3f0eede89ddd18862161d89e18b
This commit is contained in:
Vincent St-Amour 2014-04-25 13:40:39 -04:00
parent 5af4daf7d9
commit 9688d1a083
3 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,9 +49,13 @@
(begin0
(case-lambda
#,@(for/list ((formals (in-syntax #'(formals ...)))
(bodies (in-syntax #'(bodies ...)))
#:unless (dead-lambda-branch? formals))
(cons formals (stx-map (optimize) bodies))))
(bodies (in-syntax #'(bodies ...))))
(if (dead-lambda-branch? formals)
;; keep the clause (to have a case-lambda with the right arity)
;; but not the body (to make the function smaller for inlining)
;; TODO could do better, and keep a single clause per arity
(list formals #'(void)) ; return type doesn't matter, should never run
(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 ...)))

19
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/dead-case-lambda.rkt Normal file
View File

@ -0,0 +1,19 @@
#;#;
#<<END
TR opt: dead-case-lambda.rkt 4:10 () -- dead case-lambda branch
TR opt: dead-case-lambda.rkt 6:10 (d . rst) -- dead case-lambda branch
END
#<<END
(arity-at-least 0)
END
#lang typed/racket
#reader tests/typed-racket/optimizer/reset-port
(procedure-arity
(ann (case-lambda
[() (void)]
[(d) (void)]
[(d . rst) (void)])
(Any -> Any)))

2
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-for.rkt
View File

@ -2,7 +2,6 @@
#<<END
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- call to fun with unboxed args
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- fun -> unboxed fun
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- unbox float-complex
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- unboxed call site
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- unboxed call site
TR opt: unboxed-for.rkt 2:0 (for/fold: : Float-Complex ((sum : Float-Complex 0.0+0.0i)) ((i : Float-Complex (quote (1.0+2.0i 2.0+4.0i)))) (+ i sum)) -- unboxed let bindings
@ -17,6 +16,7 @@ TR opt: unboxed-for.rkt 2:53 0.0+0.0i -- unboxed literal
TR opt: unboxed-for.rkt 3:13 i -- unboxed complex variable
TR opt: unboxed-for.rkt 3:13 i -- unboxed complex variable
TR opt: unboxed-for.rkt 3:33 (quote (1.0+2.0i 2.0+4.0i)) -- in-list
TR opt: unboxed-for.rkt 3:33 (quote (1.0+2.0i 2.0+4.0i)) -- unbox float-complex
TR opt: unboxed-for.rkt 4:11 sum -- leave var unboxed
TR opt: unboxed-for.rkt 4:6 (+ i sum) -- unboxed binary float complex
TR opt: unboxed-for.rkt 4:9 i -- leave var unboxed