diff --git a/pkgs/racket-doc/scribblings/reference/generic.scrbl b/pkgs/racket-doc/scribblings/reference/generic.scrbl
index 48c92718f0..dbf1d9caa2 100644
--- a/pkgs/racket-doc/scribblings/reference/generic.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/generic.scrbl
@@ -299,4 +299,56 @@ a @tech{chaperone} of @racket[val-expr] otherwise.
 
 }
 
+@defform[(make-struct-type-property/generic
+           name-expr
+           maybe-guard-expr
+           maybe-supers-expr
+           maybe-can-impersonate?-expr
+           property-option
+           ...)
+  #:grammar
+  ([maybe-guard-expr (code:line) guard-expr]
+   [maybe-supers-expr (code:line) supers-expr]
+   [maybe-can-impersonate?-expr (code:line) can-impersonate?-expr]
+   [property-option (code:line #:property prop-expr val-expr)
+                    (code:line #:methods gen:name-id method-defs)]
+   [method-defs (definition ...)])
+  #:contracts
+  ([name-expr symbol?]
+   [guard-expr (or/c procedure? #f 'can-impersonate)]
+   [supers-expr (listof (cons/c struct-type-property? (-> any/c any/c)))]
+   [can-impersonate?-expr any/c]
+   [prop-expr struct-type-property?]
+   [val-expr any/c])]{
+Creates a new structure type property and returns three
+values, just like @racket[make-struct-type-property] would:
+
+@itemize[
+ @item{a @tech{structure type property descriptor}}
+ @item{a @tech{property predicate} procedure}
+ @item{a @tech{property accessor} procedure}
+]
+
+Any struct that implements this property will also implement
+the properties and @tech{generic interfaces} given in the
+@racket[#:property] and @racket[#:methods] declarations.
+The property @racket[val-expr]s and @racket[method-def]s are
+evaluated eagerly when the property is created, not when
+it is attached to a structure type.
+}
+
+@defform[(make-generic-struct-type-property
+            gen:name-id
+            method-def
+            ...)]{
+Creates a new structure type property and returns the
+@tech{structure type property descriptor}.
+
+Any struct that implements this property will also implement
+the @tech{generic interface} given by @racket[gen:name-id]
+with the given @racket[method-def]s. The @racket[method-def]s
+are evaluated eagerly when the property is created, not when
+it is attached to a structure type.
+}
+
 @close-eval[evaluator]
diff --git a/pkgs/racket-test/tests/generic/struct-type-property.rkt b/pkgs/racket-test/tests/generic/struct-type-property.rkt
new file mode 100644
index 0000000000..b898b33c82
--- /dev/null
+++ b/pkgs/racket-test/tests/generic/struct-type-property.rkt
@@ -0,0 +1,38 @@
+#lang racket/base
+
+(require racket/generic racket/match racket/dict rackunit)
+
+(test-case "silly-dict"
+  (define prop:silly-dict
+    (make-generic-struct-type-property
+     gen:dict
+     (define (dict-ref self k [default #f])
+       'i-am-a-dict)))
+  (struct example ()
+    #:transparent
+    #:property prop:silly-dict #f)
+  (check-equal? (dict-ref (example) 42) 'i-am-a-dict))
+
+(test-case "container-repr"
+  (define-generics repr (->sexpr repr)
+    #:defaults
+    ([number? (define (->sexpr n) n)]
+     [symbol? (define (->sexpr s) `',s)]))
+  (define-values [prop:container container? container-ref]
+    (make-struct-type-property/generic
+     'container
+     #:methods gen:repr
+     [(define/generic gen->sexpr ->sexpr)
+      (define (->sexpr self)
+        (match ((container-ref self) self)
+          [(cons constructor contents)
+           (cons constructor (map gen->sexpr contents))]))]))
+  (struct foo (a b c)
+    #:property prop:container
+    (lambda (self)
+      (list 'foo (foo-a self) (foo-b self) (foo-c self))))
+  (check-equal? (->sexpr (foo 1 2 3)) '(foo 1 2 3))
+  (check-equal? (->sexpr (foo 'a 'b 'c)) '(foo 'a 'b 'c))
+  (check-equal? (->sexpr (foo 'a 1 (foo 'b 2 'empty)))
+                '(foo 'a 1 (foo 'b 2 'empty))))
+
diff --git a/racket/collects/racket/generic.rkt b/racket/collects/racket/generic.rkt
index 8fc95b11ca..4dabf700b2 100644
--- a/racket/collects/racket/generic.rkt
+++ b/racket/collects/racket/generic.rkt
@@ -3,6 +3,7 @@
          racket/contract/combinator
          "private/generic.rkt"
          "private/generic-methods.rkt"
+         "private/struct-type-property.rkt"
          (for-syntax racket/base racket/syntax syntax/stx))
 
 ;; Convenience layer on top of racket/private/generic.
@@ -19,7 +20,9 @@
          chaperone-generics
          impersonate-generics
          redirect-generics
-         generic-instance/c)
+         generic-instance/c
+         make-struct-type-property/generic
+         make-generic-struct-type-property)
 
 (begin-for-syntax
 
diff --git a/racket/collects/racket/private/struct-type-property.rkt b/racket/collects/racket/private/struct-type-property.rkt
new file mode 100644
index 0000000000..ebb62d4d6f
--- /dev/null
+++ b/racket/collects/racket/private/struct-type-property.rkt
@@ -0,0 +1,131 @@
+#lang racket/base
+
+(provide make-struct-type-property/generic
+         make-generic-struct-type-property)
+
+(require racket/function
+         "generic-methods.rkt"
+         (for-syntax racket/base
+                     syntax/stx))
+
+(begin-for-syntax
+  ;; stx-expr? : Stx -> Bool
+  (define (stx-expr? v)
+    (not (keyword? (if (syntax? v) (syntax-e v) v))))
+
+  ;; super-pairs : Stx Stx [Listof Stx] -> [Listof Stx]
+  (define (option-super-pairs ctx stx acc)
+    (cond
+      [(stx-null? stx) (reverse acc)]
+      [(stx-pair? stx)
+       (define kw (stx-car stx))
+       (define kwe (syntax-e kw))
+       (cond
+         [(eq? kwe '#:property)
+          (define r1 (stx-cdr stx))
+          (unless (stx-pair? r1)
+            (raise-syntax-error #f
+              "expected prop-expr and val-expr after #:property"
+              ctx
+              r1
+              (list kw)))
+          (define p (stx-car r1))
+          (unless (stx-expr? p)
+            (raise-syntax-error #f
+              "expected prop-expr and val-expr after #:property"
+              ctx
+              p))
+          (define r2 (stx-cdr r1))
+          (unless (stx-pair? r2)
+            (raise-syntax-error #f
+              "expected val-expr after #:property prop-expr"
+              ctx
+              r2
+              (list kw)))
+          (define v (stx-car r2))
+          (unless (stx-expr? v)
+            (raise-syntax-error #f
+              "expected val-expr after #:property prop-expr"
+              ctx
+              v))
+          (option-super-pairs ctx (stx-cdr r2) (cons #`(cons #,p (const #,v)) acc))]
+         [(eq? kwe '#:methods)
+          (define r1 (stx-cdr stx))
+          (unless (stx-pair? r1)
+            (raise-syntax-error #f
+              "expected gen:name-id and method-defs after #:methods"
+              ctx
+              r1
+              (list kw)))
+          (define g (stx-car r1))
+          (unless (identifier? g)
+            (raise-syntax-error #f
+              "expected gen:name-id and method-defs after #:methods"
+              ctx
+              g))
+          (define r2 (stx-cdr r1))
+          (unless (stx-pair? r2)
+            (raise-syntax-error #f
+              "expected method-defs after #:methods gen:name-id"
+              ctx
+              r2
+              (list kw)))
+          (define m (stx-car r2))
+          (unless (syntax->list m)
+            (raise-syntax-error #f
+              "expected method-defs after #:methods gen:name-id"
+              ctx
+              m))
+          (option-super-pairs ctx (stx-cdr r2)
+                              (cons #`(cons (generic-property #,g)
+                                            (const (generic-method-table #,g #,@m)))
+                                    acc))]
+         [else
+          (raise-syntax-error #f
+            "expected one of these literals: #:property or #:methods"
+            ctx
+            kw)])]
+      [else
+       (raise-syntax-error #f "bad syntax" ctx stx)])))
+
+(define-syntax make-struct-type-property/generic
+  (lambda (stx)
+    (unless (stx-pair? stx) (raise-syntax-error #f "bad syntax" stx))
+    (define r1 (stx-cdr stx))
+    (unless (stx-pair? r1) (raise-syntax-error #f "expected name-expr" stx r1))
+    (define name (stx-car r1))
+    (unless (stx-expr? name) (raise-syntax-error #f "expected name-expr" stx name))
+    (define r2 (stx-cdr r1))
+    (define-values [guard r3]
+      (if (and (stx-pair? r2) (stx-expr? (stx-car r2)))
+          (values (stx-car r2) (stx-cdr r2))
+          (values #'#f r2)))
+    (define-values [supers r4]
+      (if (and (stx-pair? r3) (stx-expr? (stx-car r3)))
+          (values (stx-car r3) (stx-cdr r3))
+          (values #''() r3)))
+    (define-values [can-impersonate? r5]
+      (if (and (stx-pair? r4) (stx-expr? (stx-car r4)))
+          (values (stx-car r4) (stx-cdr r4))
+          (values #'#f r4)))
+    (syntax-protect
+     #`(make-struct-type-property #,name
+                                  #,guard
+                                  (list* #,@(option-super-pairs stx r5 '()) #,supers)
+                                  #,can-impersonate?))))
+
+(define-syntax make-generic-struct-type-property
+  (lambda (stx)
+    (unless (stx-pair? stx) (raise-syntax-error #f "bad syntax" stx))
+    (define r1 (stx-cdr stx))
+    (unless (stx-pair? r1) (raise-syntax-error #f "expected gen:name-id" stx r1))
+    (define g (stx-car r1))
+    (unless (identifier? g) (raise-syntax-error #f "expected gen:name-id" stx g))
+    (define m (stx-cdr r1))
+    (unless (stx->list m)
+      (raise-syntax-error #f "expected method-defs after gen:name-id" stx m))
+    (syntax-protect
+     #`(let-values [((prop _pred _ref)
+                     (make-struct-type-property/generic '#,g #:methods #,g #,m))]
+         prop))))
+