From 8dbf84452183b4dfe3d6f0946cd3b7b70a3b3f6d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sat, 28 Sep 2013 10:53:29 -0400
Subject: [PATCH] Fix reporting of struct constructors in TR.

original commit: 5f2dfa51442a0adfa20a0aa44bdfb681cd18eca2
---
 .../typed-racket/optimizer/hidden-costs.rkt       |  4 +++-
 .../missed-optimizations/struct-constructor.rkt   | 15 +++++++++++++++
 2 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/missed-optimizations/struct-constructor.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt
index 1b940b4c..5f88e395 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt
@@ -29,6 +29,8 @@
   ;; Log calls to struct constructors, so that OC can report those used in
   ;; hot loops.
   (pattern (#%plain-app op:id args:opt-expr ...)
-    #:when (struct-constructor? #'op)
+    #:when (let ([constructor-for (syntax-property #'op 'constructor-for)])
+             (or (and constructor-for (struct-constructor? constructor-for))
+                 (struct-constructor? #'op)))
     #:do [(log-optimization-info "struct constructor" #'op)]
     #:with opt #'(op args.opt ...)))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/missed-optimizations/struct-constructor.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/missed-optimizations/struct-constructor.rkt
new file mode 100644
index 00000000..9945db3f
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/missed-optimizations/struct-constructor.rkt
@@ -0,0 +1,15 @@
+#;#;
+#<<END
+TR info: struct-constructor.rkt 15:7 foo -- struct constructor
+END
+#<<END
+END
+
+
+#lang typed/racket
+
+(provide (struct-out foo))
+
+(struct: foo ())
+
+(void (foo))