diff --git a/collects/racket/private/define-struct.rkt b/collects/racket/private/define-struct.rkt
index b53f338328..2010efe42f 100644
--- a/collects/racket/private/define-struct.rkt
+++ b/collects/racket/private/define-struct.rkt
@@ -83,6 +83,11 @@
         (raise-type-error name "inspector or #f" what)))
     what)
 
+  (define (check-reflection-name name what)
+    (unless (symbol? what)
+      (raise-type-error name "symbol" what))
+    what)
+
   (define-syntax (define-struct* stx)
     (syntax-case stx ()
       [(_ . rest)
@@ -203,6 +208,7 @@
                            (#:mutable . #f)
                            (#:guard . #f)
                            (#:constructor-name . #f)
+                           (#:reflection-name . #f)
                            (#:only-constructor? . #f)
                            (#:omit-define-values . #f)
                            (#:omit-define-syntaxes . #f))]
@@ -272,6 +278,13 @@
                                '#:only-constructor?
                                (eq? '#:constructor-name (syntax-e (car p))))
                 nongen?)]
+         [(eq? '#:reflection-name (syntax-e (car p)))
+          (check-exprs 1 p "expression")
+          (when (lookup config '#:reflection-name)
+            (bad "multiple" "#:reflection-name keys" (car p)))
+          (loop (cddr p)
+                (extend-config config '#:reflection-name (cadr p))
+                nongen?)]
          [(eq? '#:prefab (syntax-e (car p)))
           (when (lookup config '#:inspector)
             (bad "multiple" insp-keys "s" (car p)))
@@ -364,7 +377,8 @@
                          (car field-stxes))]
                        [else
                         (loop (cdr fields) (cdr field-stxes) #f)]))])
-               (let*-values ([(inspector super-expr props auto-val guard ctor-name ctor-only? mutable?
+               (let*-values ([(inspector super-expr props auto-val guard ctor-name ctor-only? 
+                                         reflect-name-expr mutable?
                                          omit-define-values? omit-define-syntaxes?)
                               (let ([config (parse-props #'fm (syntax->list #'(prop ...)) super-id)])
                                 (values (lookup config '#:inspector)
@@ -374,6 +388,7 @@
                                         (lookup config '#:guard)
                                         (lookup config '#:constructor-name)
                                         (lookup config '#:only-constructor?)
+                                        (lookup config '#:reflection-name)
                                         (lookup config '#:mutable)
                                         (lookup config '#:omit-define-values)
                                         (lookup config '#:omit-define-syntaxes)))]
@@ -423,7 +438,10 @@
                                           (and super-expr
                                                #`(check-struct-type 'fm #,super-expr)))]
                        [prune (lambda (stx) (identifier-prune-lexical-context stx
-                                                                              (list (syntax-e stx) '#%top)))])
+                                                                              (list (syntax-e stx) '#%top)))]
+                       [reflect-name-expr (if reflect-name-expr
+                                              (quasisyntax (check-reflection-name 'fm #,reflect-name-expr))
+                                              (quasisyntax '#,id))])
                    (let ([run-time-defns
                           (lambda ()
                             (quasisyntax/loc stx
@@ -438,7 +456,7 @@
                                                                                [else (cons #`[(_ #,(field-id (car fields))) #'#,pos]
                                                                                            (loop (cdr fields) (add1 pos)))]))
                                                                          [(_ name) (raise-syntax-error #f "no such field" stx #'name)]))])
-                                                (make-struct-type '#,id
+                                                (make-struct-type #,reflect-name-expr
                                                                   #,super-struct:
                                                                   #,(- (length fields) auto-count)
                                                                   #,auto-count
diff --git a/collects/scribblings/reference/define-struct.scrbl b/collects/scribblings/reference/define-struct.scrbl
index a0371e79fb..75a963f651 100644
--- a/collects/scribblings/reference/define-struct.scrbl
+++ b/collects/scribblings/reference/define-struct.scrbl
@@ -26,6 +26,7 @@
                               (code:line #:prefab)
                               (code:line #:constructor-name constructor-id)
                               (code:line #:extra-constructor-name constructor-id)
+                              (code:line #:reflection-name symbol-expr)
                               #:omit-define-syntaxes
                               #:omit-define-values]
                [field-option #:mutable
@@ -134,6 +135,13 @@ and it is not the same as @racket[id], then @racket[id] does not serve
 as a constructor, and @racket[object-name] on the constructor produces
 the symbolic form of @racket[constructor-id].
 
+If @racket[#:reflection-name symbol-expr] is provided, then
+@racket[symbol-expr] must produce a symbol that is used to identify
+the structure type in reflective operations such as
+@racket[struct-type-info]. It corresponds to the first argument of
+@racket[make-struct-type]. Structure printing uses the reflective
+name, as do the various procedures that are bound by @racket[struct].
+
 If the @racket[#:omit-define-syntaxes] option is supplied, then
 @racket[id] is not bound as a transformer. If the
 @racket[#:omit-define-values] option is supplied, then none of the