diff --git a/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss b/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss
new file mode 100644
index 00000000..fbc998e6
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss
@@ -0,0 +1,10 @@
+#lang typed/scheme
+
+(define-struct: x ([y : Any]) #:mutable)
+
+(define: the-x : Any (make-x 1))
+
+(if (x? the-x)
+    (x-y the-x)
+    0)
+
diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-scheme/typecheck/tc-structs.rkt
index 510b3422..6717d50b 100644
--- a/collects/typed-scheme/typecheck/tc-structs.rkt
+++ b/collects/typed-scheme/typecheck/tc-structs.rkt
@@ -111,6 +111,7 @@
                                #:maker (or maker* maker)
                                #:predicate (or pred* pred)
                                #:struct-info si
+                               #:poly? poly?
                                #:constructor-return cret))))
 
 ;; generate names, and register the approriate types give field types and structure type
@@ -123,6 +124,7 @@
                                #:pred-wrapper [pred-wrapper values]
                                #:maker [maker* #f]
                                #:predicate [pred* #f]
+                               #:poly? [poly? #f]
                                #:constructor-return [cret #f])
   ;; create the approriate names that define-struct will bind
   (define-values (struct-type-id maker pred getters setters) (struct-names nm flds setters?))
@@ -137,7 +139,7 @@
       (cons (or maker* maker)
             (wrapper (->* external-fld-types (if cret cret name))))
       (cons (or pred* pred)
-            (make-pred-ty (if setters?
+            (make-pred-ty (if (and setters? poly?)
                               (make-StructTop sty)
                               (pred-wrapper name)))))
      (for/list ([g (in-list getters)] [t (in-list external-fld-types/no-parent)] [i (in-naturals)])