From 9688d1a0838d9da74407fb14566167591cdb0154 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 25 Apr 2014 13:40:39 -0400 Subject: [PATCH] Keep dead case-lambda clauses around to avoid changing arity. Closes PR14468. original commit: ce3033a0c7e0c3f0eede89ddd18862161d89e18b --- .../typed-racket/optimizer/dead-code.rkt | 10 +++++++--- .../optimizer/tests/dead-case-lambda.rkt | 19 +++++++++++++++++++ .../optimizer/tests/unboxed-for.rkt | 2 +- 3 files changed, 27 insertions(+), 4 deletions(-) create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/dead-case-lambda.rkt 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 e243b3e4..210cbab9 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 @@ -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 ...))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/dead-case-lambda.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/dead-case-lambda.rkt new file mode 100644 index 00000000..b6dc675f --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/dead-case-lambda.rkt @@ -0,0 +1,19 @@ +#;#; +#< Any))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-for.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-for.rkt index a4f408ea..8200c6fe 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-for.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/unboxed-for.rkt @@ -2,7 +2,6 @@ #< 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