diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt
index aa57721056..b98a86a782 100644
--- a/racket/collects/racket/contract/private/guts.rkt
+++ b/racket/collects/racket/contract/private/guts.rkt
@@ -38,6 +38,7 @@
          ;; helpers for adding properties that check syntax uses
          define/final-prop
          define/subexpression-pos-prop
+         define/subexpression-pos-prop/name
          
          make-predicate-contract
          
@@ -332,6 +333,42 @@
                              (list (car (syntax-e stx)))
                              '())))])))))]))
 
+(define-syntax (define/subexpression-pos-prop/name stx)
+  (syntax-case stx ()
+    [(_ ctc/proc header bodies ...)
+     (with-syntax ([ctc (if (identifier? #'header)
+                            #'header
+                            (car (syntax-e #'header)))])
+       #'(begin
+           (define ctc/proc
+             (let ()
+               (define header bodies ...)
+               ctc))
+           (define-syntax (ctc stx)
+             (syntax-case stx ()
+               [x
+                (identifier? #'x)
+                (syntax-property
+                 #'ctc/proc
+                 'racket/contract:contract
+                 (vector (gensym 'ctc)
+                         (list stx)
+                         '()))]
+               [(_ margs (... ...))
+                (let ([this-one (gensym 'ctc)])
+                  (with-syntax ([(margs (... ...))
+                                 (map (λ (x) (syntax-property x
+                                                              'racket/contract:positive-position
+                                                              this-one))
+                                      (syntax->list #'(margs (... ...))))]
+                                [app (datum->syntax stx '#%app)])
+                    (syntax-property
+                     #'(app ctc/proc margs (... ...))
+                     'racket/contract:contract
+                     (vector this-one
+                             (list (car (syntax-e stx)))
+                             '()))))]))))]))
+
 (define-syntax (define/subexpression-pos-prop stx)
   (syntax-case stx ()
     [(_ header bodies ...)
@@ -339,35 +376,7 @@
                             #'header
                             (car (syntax-e #'header)))])
        (with-syntax ([ctc/proc (string->symbol (format "~a/proc" (syntax-e #'ctc)))])
-         #'(begin
-             (define ctc/proc
-               (let ()
-                 (define header bodies ...)
-                 ctc))
-             (define-syntax (ctc stx)
-               (syntax-case stx ()
-                 [x
-                  (identifier? #'x)
-                  (syntax-property 
-                   #'ctc/proc
-                   'racket/contract:contract 
-                   (vector (gensym 'ctc) 
-                           (list stx)
-                           '()))]
-                 [(_ margs (... ...))
-                  (let ([this-one (gensym 'ctc)])
-                    (with-syntax ([(margs (... ...)) 
-                                   (map (λ (x) (syntax-property x
-                                                                'racket/contract:positive-position
-                                                                this-one))
-                                        (syntax->list #'(margs (... ...))))]
-                                  [app (datum->syntax stx '#%app)])
-                      (syntax-property 
-                       #'(app ctc/proc margs (... ...))
-                       'racket/contract:contract 
-                       (vector this-one 
-                               (list (car (syntax-e stx)))
-                               '()))))])))))]))
+         #'(define/subexpression-pos-prop/name ctc/proc header bodies ...)))]))
 
 ;; build-compound-type-name : (union contract symbol) ... -> (-> sexp)
 (define (build-compound-type-name . fs)
diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt
index a702633c58..f01fd1c6b2 100644
--- a/racket/collects/racket/contract/private/misc.rkt
+++ b/racket/collects/racket/contract/private/misc.rkt
@@ -307,7 +307,7 @@
      (identifier? #'x)
      #'real-and/c]))
 
-(define/subexpression-pos-prop (real-and/c . raw-fs)
+(define/subexpression-pos-prop/name real-and/c-name (real-and/c . raw-fs)
   (let ([contracts (coerce-contracts 'and/c raw-fs)])
     (cond
       [(null? contracts) any/c]
diff --git a/racket/collects/racket/contract/private/orc.rkt b/racket/collects/racket/contract/private/orc.rkt
index 1dca65b0f3..d61f49dbb0 100644
--- a/racket/collects/racket/contract/private/orc.rkt
+++ b/racket/collects/racket/contract/private/orc.rkt
@@ -12,7 +12,7 @@
          blame-add-ior-context
          (rename-out [_flat-rec-contract flat-rec-contract]))
 
-(define/subexpression-pos-prop or/c
+(define/subexpression-pos-prop/name or/c-name or/c
   (case-lambda 
     [() (make-none/c '(or/c))]
     [(x) (coerce-contract 'or/c x)]
diff --git a/racket/collects/racket/contract/private/types.rkt b/racket/collects/racket/contract/private/types.rkt
new file mode 100644
index 0000000000..d625f2da65
--- /dev/null
+++ b/racket/collects/racket/contract/private/types.rkt
@@ -0,0 +1,10 @@
+#lang racket/base
+(provide types)
+(define types
+  (hash '(real-and/c-name racket/contract/private/misc)
+        '(->* () #:rest Contract Contract)
+        
+        '(or/c-name racket/contract/private/orc)
+        '(->* () #:rest Contract Contract)))
+
+;; cast : alpha (<alpha,beta> ctc) -> beta
\ No newline at end of file