diff --git a/collects/racket/contract.rkt b/collects/racket/contract.rkt
index 6a4d090b99..6321b3cc19 100644
--- a/collects/racket/contract.rkt
+++ b/collects/racket/contract.rkt
@@ -3,7 +3,6 @@
          "contract/combinator.rkt"
          "contract/parametric.rkt"
          "contract/region.rkt"
-         "contract/private/basic-opters.rkt"
          "contract/private/legacy.rkt"
          "contract/private/ds.rkt"
          "contract/private/generate.rkt")
diff --git a/collects/racket/contract/base.rkt b/collects/racket/contract/base.rkt
index f8ebab7a3c..3f8a81697b 100644
--- a/collects/racket/contract/base.rkt
+++ b/collects/racket/contract/base.rkt
@@ -11,7 +11,8 @@
          "private/misc.rkt"
          "private/provide.rkt"
          "private/guts.rkt"
-         "private/opters.rkt" ;; required for effect to install the opters
+         "private/opters.rkt"       ;; required for effect to install the opters
+         "private/basic-opters.rkt" ;; required for effect to install the opters
          "private/opt.rkt"
          "private/out.rkt")
 
diff --git a/collects/racket/contract/private/basic-opters.rkt b/collects/racket/contract/private/basic-opters.rkt
index 90c242914d..379c783f60 100644
--- a/collects/racket/contract/private/basic-opters.rkt
+++ b/collects/racket/contract/private/basic-opters.rkt
@@ -10,7 +10,7 @@
 ;;
 ;; opt/pred helper
 ;;
-(define-for-syntax (opt/pred opt/info pred)
+(define-for-syntax (opt/pred opt/info pred #:name [name (syntax-e pred)])
   (with-syntax ((pred pred))
     (build-optres
      #:exp
@@ -26,7 +26,8 @@
      #:flat (syntax (pred val))
      #:opt #f
      #:stronger-ribs null
-     #:chaperone #t)))
+     #:chaperone #t
+     #:name #`'#,name)))
 
 (define (raise-opt/pred-error blame val pred-name)
   (raise-blame-error
@@ -61,12 +62,13 @@
                    #:flat #'#t
                    #:opt #f
                    #:stronger-ribs null
-                   #:chaperone #t)]))
+                   #:chaperone #t
+                   #:name #''any/c)]))
 
 ;;
 ;; false/c
 ;;
-(define/opter (false/c opt/i opt/info stx) (opt/pred opt/info #'not))
+(define/opter (false/c opt/i opt/info stx) (opt/pred opt/info #'not #:name '#f))
 
 ;;
 ;; flat-contract helper
@@ -106,7 +108,8 @@
           #:flat (syntax (lift-pred val))
           #:opt #f
           #:stronger-ribs null
-          #:chaperone #t)))]))
+          #:chaperone #t
+          #:name #'(object-name lift-pred))))]))
 
 ;;
 ;; flat-contract and friends
diff --git a/collects/racket/contract/private/ds-helpers.rkt b/collects/racket/contract/private/ds-helpers.rkt
index 930b4f91d0..edbf209274 100644
--- a/collects/racket/contract/private/ds-helpers.rkt
+++ b/collects/racket/contract/private/ds-helpers.rkt
@@ -177,13 +177,20 @@ which are then called when the contract's fields are explored
                [maker-args '()]
                [lifts-ps '()]
                [superlifts-ps '()]
-               [stronger-ribs-ps '()])
+               [stronger-ribs-ps '()]
+               [any-deps? #f]
+               [names '()])
       (cond
         [(null? clauses)
          (values (reverse maker-args)
                  lifts-ps
                  superlifts-ps
-                 stronger-ribs-ps)]
+                 stronger-ribs-ps
+                 (if any-deps? ;; the else branch here is an ugly hack
+                     #`(list '#,name #,@(reverse names))
+                     #`(list '#,(string->symbol (regexp-replace #rx"/dc$" (symbol->string name) "/c"))
+                             #,@(map (λ (x) #`(cadr #,x)) 
+                                     (reverse names)))))]
         [else
          (let ([clause (car clauses)]
                [let-var (car let-vars)]
@@ -217,7 +224,10 @@ which are then called when the contract's fields are explored
                       (cons maker-arg maker-args)
                       lifts-ps
                       superlifts-ps
-                      stronger-ribs-ps))]
+                      stronger-ribs-ps
+                      #t
+                      (cons #`(list 'id '(... ...))
+                            names)))]
              [(id (x ...) ctc-exp)
               (begin
                 (unless (identifier? (syntax id))
@@ -242,7 +252,11 @@ which are then called when the contract's fields are explored
                       (cons maker-arg maker-args)
                       (append lifts-ps (optres-lifts an-optres))
                       (append superlifts-ps (optres-superlifts an-optres))
-                      (append stronger-ribs-ps (optres-stronger-ribs an-optres))))]
+                      (append stronger-ribs-ps (optres-stronger-ribs an-optres))
+                      any-deps?
+                      (cons 
+                       #`(list 'id #,(optres-name an-optres))
+                       names)))]
              [(id ctc-exp)
               (raise-syntax-error name "expected identifier" stx (syntax id))]))]))))
 
diff --git a/collects/racket/contract/private/ds.rkt b/collects/racket/contract/private/ds.rkt
index f930be2212..246fd1de5f 100644
--- a/collects/racket/contract/private/ds.rkt
+++ b/collects/racket/contract/private/ds.rkt
@@ -354,7 +354,7 @@ it around flattened out.
                               (cdr free-vars))])))
             
             (let*-values ([(inner-val) #'val]
-                          [(clauses lifts superlifts stronger-ribs)
+                          [(clauses lifts superlifts stronger-ribs names)
                            (build-enforcer-clauses opt/i
                                                    (opt/info-change-val inner-val opt/info)
                                                    name
@@ -379,7 +379,8 @@ it around flattened out.
                               (values f-x ...)))))
                  lifts
                  superlifts
-                 stronger-ribs))))
+                 stronger-ribs
+                 names))))
           
           ;;
           ;; struct/dc opter
@@ -391,7 +392,7 @@ it around flattened out.
                      (helper-id-var (car (generate-temporaries (syntax (helper)))))
                      (contract/info-var (car (generate-temporaries (syntax (contract/info)))))
                      (id-var (car (generate-temporaries (syntax (id))))))
-                 (let-values ([(enforcer lifts superlifts stronger-ribs)
+                 (let-values ([(enforcer lifts superlifts stronger-ribs names)
                                (build-enforcer opt/i
                                                opt/info
                                                'struct/dc
@@ -470,7 +471,8 @@ it around flattened out.
                             #:flat #f
                             #:opt #f
                             #:stronger-ribs stronger-ribs
-                            #:chaperone #f)))))))])))))))
+                            #:chaperone #f
+                            #:name names)))))))])))))))
 
 (define-syntax (define-contract-struct stx)
   (syntax-case stx ()
diff --git a/collects/racket/contract/private/misc.rkt b/collects/racket/contract/private/misc.rkt
index 96503a51ae..76b22eb2be 100644
--- a/collects/racket/contract/private/misc.rkt
+++ b/collects/racket/contract/private/misc.rkt
@@ -106,43 +106,46 @@
   (case-lambda 
     [() (make-none/c '(or/c))]
     [raw-args
-     (let ([args (coerce-contracts 'or/c raw-args)])
-       (let-values ([(ho-contracts flat-contracts)
-                     (let loop ([ho-contracts '()]
-                                [flat-contracts '()]
-                                [args args])
-                       (cond
-                         [(null? args) (values ho-contracts (reverse flat-contracts))]
-                         [else 
-                          (let ([arg (car args)])
-                            (cond
-                              [(flat-contract? arg)
-                               (loop ho-contracts (cons arg flat-contracts) (cdr args))]
-                              [else
-                               (loop (cons arg ho-contracts) flat-contracts (cdr args))]))]))])
-         (let ([pred 
-                (cond
-                  [(null? flat-contracts) not]
-                  [else
-                   (let loop ([fst (car flat-contracts)]
-                              [rst (cdr flat-contracts)])
-                     (let ([fst-pred (flat-contract-predicate fst)])
-                       (cond
-                         [(null? rst) fst-pred]
-                         [else 
-                          (let ([r (loop (car rst) (cdr rst))])
-                            (λ (x) (or (fst-pred x) (r x))))])))])])
-           (cond
-             [(null? ho-contracts)
-              (make-flat-or/c pred flat-contracts)]
-             [(null? (cdr ho-contracts))
-              (if (chaperone-contract? (car ho-contracts))
-                  (make-chaperone-single-or/c pred flat-contracts (car ho-contracts))
-                  (make-impersonator-single-or/c pred flat-contracts (car ho-contracts)))]
-             [else
-              (if (andmap chaperone-contract? ho-contracts)
-                  (make-chaperone-multi-or/c flat-contracts ho-contracts)
-                  (make-impersonator-multi-or/c flat-contracts ho-contracts))]))))]))
+     (define args (coerce-contracts 'or/c raw-args))
+     (define-values (ho-contracts flat-contracts)
+       (let loop ([ho-contracts '()]
+                  [flat-contracts '()]
+                  [args args])
+         (cond
+           [(null? args) (values ho-contracts (reverse flat-contracts))]
+           [else 
+            (let ([arg (car args)])
+              (cond
+                [(flat-contract? arg)
+                 (loop ho-contracts (cons arg flat-contracts) (cdr args))]
+                [else
+                 (loop (cons arg ho-contracts) flat-contracts (cdr args))]))])))
+     (define pred 
+       (cond
+         [(null? flat-contracts) not]
+         [else
+          (let loop ([fst (car flat-contracts)]
+                     [rst (cdr flat-contracts)])
+            (let ([fst-pred (flat-contract-predicate fst)])
+              (cond
+                [(null? rst) fst-pred]
+                [else 
+                 (let ([r (loop (car rst) (cdr rst))])
+                   (λ (x) (or (fst-pred x) (r x))))])))]))
+     
+     (cond
+       [(null? ho-contracts)
+        (make-flat-or/c pred flat-contracts)]
+       [(null? (cdr ho-contracts))
+        (define name (apply build-compound-type-name 'or/c args))
+        (if (chaperone-contract? (car ho-contracts))
+            (make-chaperone-single-or/c name pred flat-contracts (car ho-contracts))
+            (make-impersonator-single-or/c name pred flat-contracts (car ho-contracts)))]
+       [else
+        (define name (apply build-compound-type-name 'or/c args))
+        (if (andmap chaperone-contract? ho-contracts)
+            (make-chaperone-multi-or/c name flat-contracts ho-contracts)
+            (make-impersonator-multi-or/c name flat-contracts ho-contracts))])]))
 
 (define (single-or/c-projection ctc)
   (let ([c-proc (contract-projection (single-or/c-ho-ctc ctc))]
@@ -155,12 +158,6 @@
           [(pred val) val]
           [else (partial-contract val)])))))
 
-(define (single-or/c-name ctc)
-  (apply build-compound-type-name 
-         'or/c 
-         (single-or/c-ho-ctc ctc)
-         (single-or/c-flat-ctcs ctc)))
-
 (define (single-or/c-first-order ctc)
   (let ([pred (single-or/c-pred ctc)]
         [ho (contract-first-order (single-or/c-ho-ctc ctc))])
@@ -177,7 +174,7 @@
                       this-ctcs
                       that-ctcs)))))
 
-(define-struct single-or/c (pred flat-ctcs ho-ctc))
+(define-struct single-or/c (name pred flat-ctcs ho-ctc))
 
 (define-struct (chaperone-single-or/c single-or/c) ()
   #:property prop:chaperone-contract
@@ -242,13 +239,6 @@
                       candidate-proc
                       candidate-contract)]))])))))
 
-(define (multi-or/c-name ctc)
-  (apply build-compound-type-name 
-         'or/c 
-         (append
-          (multi-or/c-flat-ctcs ctc)
-          (reverse (multi-or/c-ho-ctcs ctc)))))
-
 (define (multi-or/c-first-order ctc)
   (let ([flats (map flat-contract-predicate (multi-or/c-flat-ctcs ctc))]
         [hos (map (λ (x) (contract-first-order x)) (multi-or/c-ho-ctcs ctc))])
@@ -267,7 +257,7 @@
          (and (= (length this-ctcs) (length that-ctcs))
               (andmap contract-stronger? this-ctcs that-ctcs)))))
 
-(define-struct multi-or/c (flat-ctcs ho-ctcs))
+(define-struct multi-or/c (name flat-ctcs ho-ctcs))
 
 (define-struct (chaperone-multi-or/c multi-or/c) ()
   #:property prop:chaperone-contract
@@ -328,8 +318,7 @@
    #:generate
    (λ (ctc)
       (λ (fuel)
-         (generate/direct (oneof (flat-or/c-flat-ctcs ctc)) fuel)))
-         ))
+         (generate/direct (oneof (flat-or/c-flat-ctcs ctc)) fuel)))))
 
 
 (define (and-name ctc)
diff --git a/collects/racket/contract/private/opt-guts.rkt b/collects/racket/contract/private/opt-guts.rkt
index ac67664b54..6dee8e0e6d 100644
--- a/collects/racket/contract/private/opt-guts.rkt
+++ b/collects/racket/contract/private/opt-guts.rkt
@@ -33,6 +33,7 @@
          optres-stronger-ribs
          optres-chaperone
          optres-no-negative-blame?
+         optres-name
          build-optres
          
          combine-two-chaperone?s
@@ -40,9 +41,9 @@
 
 ;; (define/opter (<contract-combinator> opt/i opt/info stx) body)
 ;;
-;; An opter is to a function with the following signature: 
+;; An opter is a function with the following signature: 
 ;;
-;; opter : (syntax opt/info -> <opter-results>) opt/info list-of-ids -> opt-res
+;; opter : (syntax opt/info -> optres) opt/info list-of-ids -> optres
 ;;
 ;; The first argument can be used to recursively process sub-contracts
 ;; It returns what an opter returns and its results should be accumulated
@@ -90,7 +91,8 @@
                 opt
                 stronger-ribs
                 chaperone
-                no-negative-blame?))
+                no-negative-blame?
+                name))
 (define (build-optres #:exp exp
                       #:lifts lifts
                       #:superlifts superlifts
@@ -99,7 +101,8 @@
                       #:opt opt
                       #:stronger-ribs stronger-ribs
                       #:chaperone chaperone
-                      #:no-negative-blame? [no-negative-blame? (syntax? flat)])
+                      #:no-negative-blame? [no-negative-blame? (syntax? flat)]
+                      #:name [name #''unknown-name])
   (optres exp 
           lifts
           superlifts
@@ -108,7 +111,8 @@
           opt
           stronger-ribs
           chaperone
-          no-negative-blame?))
+          no-negative-blame?
+          name))
 
 ;; a hash table of opters
 (define opters-table
@@ -274,7 +278,8 @@
      #:flat #f
      #:opt #'lift-var
      #:stronger-ribs null
-     #:chaperone #'(chaperone-contract? lift-var))))
+     #:chaperone #'(chaperone-contract? lift-var)
+     #:name #'(contract-name lift-var))))
 
 ;; combine-two-chaperone?s : (or/c boolean? syntax?) (or/c boolean? syntax?) -> (or/c boolean? syntax?)
 (define (combine-two-chaperone?s chaperone-a? chaperone-b?)
diff --git a/collects/racket/contract/private/opt.rkt b/collects/racket/contract/private/opt.rkt
index 7894c3ea39..7667466be4 100644
--- a/collects/racket/contract/private/opt.rkt
+++ b/collects/racket/contract/private/opt.rkt
@@ -94,7 +94,8 @@
    #:flat predicate
    #:opt #f
    #:stronger-ribs null
-   #:chaperone #t))
+   #:chaperone #t
+   #:name #`'#,konst))
 
 (define (opt-constant-contract-failure blame val compare should-be)
   (raise-blame-error blame val '(expected "a value ~a to ~e") compare should-be))
@@ -185,7 +186,7 @@
                 #,(bind-superlifts
                    (optres-partials an-optres)
                    #`(λ (val) #,(optres-exp an-optres)))))
-            (λ () e)
+            #,(optres-name an-optres)
             (λ (this that) #f)
             (vector)
             (begin-lifted (box #f))
@@ -202,8 +203,7 @@
        [else
         (define info (make-opt/info #'ctc #'val #'blame #f '() #f #f #'this #'that))
         (define an-optres (opt/i info #'e))
-        #`(let ([ctc e] ;;; hm... what to do about this?!
-                [val val-e]
+        #`(let ([val val-e]
                 [blame blame-e])
             #,(bind-superlifts
                (optres-superlifts an-optres)
@@ -292,13 +292,13 @@
 ;; the stronger-vars don't seem to be used anymore for stronger; probably
 ;; they should be folded into the lifts and then there should be a separate
 ;; setup for consolidating stronger checks
-(define-struct opt-contract (proj orig-ctc stronger stronger-vars stamp chaperone?)
-  #:property orig-ctc-prop (λ (ctc) ((opt-contract-orig-ctc ctc)))
+(define-struct opt-contract (proj name stronger stronger-vars stamp chaperone?)
   #:property prop:opt-chaperone-contract (λ (ctc) (opt-contract-chaperone? ctc))
+  #:property prop:custom-write (λ (val port mode) (fprintf port "#<opt-contract: ~.s>" (opt-contract-name val)))
   #:property prop:contract
   (build-contract-property
    #:projection (λ (ctc) ((opt-contract-proj ctc) ctc))
-   #:name (λ (ctc) (contract-name ((orig-ctc-get ctc) ctc)))
+   #:name (λ (ctc) (opt-contract-name ctc))
    #:stronger
    (λ (this that)
       (and (opt-contract? that)
diff --git a/collects/racket/contract/private/opters.rkt b/collects/racket/contract/private/opters.rkt
index cd9027d64c..5da77f7357 100644
--- a/collects/racket/contract/private/opters.rkt
+++ b/collects/racket/contract/private/opters.rkt
@@ -20,7 +20,6 @@
                      (val (opt/info-val opt/info)))
          (syntax (partial-var val)))
        (list (cons lift-var 
-                   ;; FIXME needs to get the contract name somehow
                    (with-syntax ((uctc uctc))
                      (syntax (coerce-contract 'opt/c uctc)))))
        '()
@@ -28,13 +27,15 @@
               partial-var
               (with-syntax ((lift-var lift-var)
                             (blame (opt/info-blame opt/info)))
-                (syntax ((contract-projection lift-var) blame))))))))
+                (syntax ((contract-projection lift-var) blame)))))
+       #`(contract-name #,lift-var))))
   
   (define (opt/or-ctc ps)
     (define lift-from-hos null)
     (define superlift-from-hos null)
     (define partial-from-hos null)
-    (define-values (opt-ps lift-ps superlift-ps partial-ps stronger-ribs hos ho-ctc chaperone? no-negative-blame)
+    (define name-from-hos #f)
+    (define-values (opt-ps lift-ps superlift-ps partial-ps stronger-ribs hos ho-ctc chaperone? no-negative-blame names)
       (let loop ([ps ps]
                  [next-ps null]
                  [lift-ps null]
@@ -44,7 +45,8 @@
                  [hos null]
                  [ho-ctc #f]
                  [chaperone? #t]
-                 [no-negative-blame #t])
+                 [no-negative-blame #t]
+                 [names '()])
         (cond
           [(null? ps) (values next-ps
                               lift-ps
@@ -54,7 +56,8 @@
                               (reverse hos)
                               ho-ctc
                               chaperone?
-                              no-negative-blame)]
+                              no-negative-blame
+                              (reverse names))]
           [else
            (define ps-optres (opt/i opt/info (car ps)))
            (if (optres-flat ps-optres)
@@ -67,7 +70,8 @@
                      hos
                      ho-ctc
                      (combine-two-chaperone?s chaperone? (optres-chaperone ps-optres))
-                     (combine-two-no-negative-blame no-negative-blame (optres-no-negative-blame? ps-optres)))
+                     (combine-two-no-negative-blame no-negative-blame (optres-no-negative-blame? ps-optres))
+                     (cons (optres-name ps-optres) names))
                (if (null? hos)
                    (loop (cdr ps)
                          next-ps
@@ -78,7 +82,8 @@
                          (cons (car ps) hos)
                          (optres-exp ps-optres)
                          (combine-two-chaperone?s chaperone? (optres-chaperone ps-optres))
-                         (combine-two-no-negative-blame no-negative-blame (optres-no-negative-blame? ps-optres)))
+                         (combine-two-no-negative-blame no-negative-blame (optres-no-negative-blame? ps-optres))
+                         (cons (optres-name ps-optres) names))
                    (loop (cdr ps)
                          next-ps
                          lift-ps
@@ -88,7 +93,8 @@
                          (cons (car ps) hos)
                          ho-ctc
                          chaperone?
-                         no-negative-blame)))])))
+                         no-negative-blame
+                         names)))])))
     (with-syntax ((next-ps
                    (with-syntax (((opt-p ...) (reverse opt-ps)))
                      (syntax (or opt-p ...)))))
@@ -111,10 +117,11 @@
              (if next-ps val ho-ctc)))]
          ;; FIXME something's not right with this case.
          [(> (length hos) 1)
-          (define-values (exp new-lifts new-superlifts new-partials) (opt/or-unknown stx))
+          (define-values (exp new-lifts new-superlifts new-partials name) (opt/or-unknown stx))
           (set! lift-from-hos new-lifts)
           (set! superlift-from-hos new-superlifts)
           (set! partial-from-hos new-partials)
+          (set! name-from-hos name)
           #`(if next-ps val #,exp)])
        #:lifts
        (append lift-ps lift-from-hos)
@@ -127,7 +134,8 @@
        #:opt #f
        #:stronger-ribs stronger-ribs
        #:chaperone chaperone?
-       #:no-negative-blame? no-negative-blame)))
+       #:no-negative-blame? no-negative-blame
+       #:name (or name-from-hos #`(list 'or/c #,@names)))))
   
   (syntax-case stx (or/c)
     [(or/c p ...)
@@ -176,8 +184,8 @@
                        (with-syntax ([this this]
                                      [that that])
                          (syntax (<= this that))))))
-              #:chaperone
-              #t)))))]))
+              #:chaperone #t
+              #:name #''(between/c n m))))))]))
 
 (define (raise-opt-between/c-error blame val lo hi)
   (raise-blame-error
@@ -186,7 +194,7 @@
    '(expected: "a number between ~a and ~a" given: "~e")
    lo hi val))
 
-(define-for-syntax (single-comparison-opter opt/info stx check-arg comparison arg)
+(define-for-syntax (single-comparison-opter opt/info stx check-arg comparison arg name)
   (with-syntax ([comparison comparison])
     (let*-values ([(lift-low lifts2) (lift/binding arg 'single-comparison-val empty-lifts)])
       (with-syntax ([m lift-low])
@@ -214,7 +222,8 @@
                       (with-syntax ([this this]
                                     [that that])
                         (syntax (comparison this that))))))
-             #:chaperone #t)))))))
+             #:chaperone #t
+             #:name #`'(#,name m))))))))
 
 (define (raise-opt-single-comparison-opter-error blame val comparison m)
   (raise-blame-error
@@ -233,7 +242,8 @@
       (λ (m) (with-syntax ([m m])
                #'(check-unary-between/c '=/c m)))
       #'=
-      #'x)]))
+      #'x
+      '=/c)]))
 
 (define/opter (>=/c opt/i opt/info stx)
   (syntax-case stx (>=/c)
@@ -244,7 +254,8 @@
       (λ (m) (with-syntax ([m m])
                #'(check-unary-between/c '>=/c m)))
       #'>=
-      #'low)]))
+      #'low
+      '>=/c)]))
 
 (define/opter (<=/c opt/i opt/info stx)
   (syntax-case stx (<=/c)
@@ -255,7 +266,8 @@
       (λ (m) (with-syntax ([m m])
                #'(check-unary-between/c '<=/c m)))
       #'<=
-      #'high)]))
+      #'high
+      '<=/c)]))
 
 (define/opter (>/c opt/i opt/info stx)
   (syntax-case stx (>/c)
@@ -266,7 +278,8 @@
       (λ (m) (with-syntax ([m m])
                #'(check-unary-between/c '>/c m)))
       #'>
-      #'low)]))
+      #'low
+      '>/c)]))
 
 (define/opter (</c opt/i opt/info stx)
   (syntax-case stx (</c)
@@ -277,7 +290,8 @@
       (λ (m) (with-syntax ([m m])
                #'(check-unary-between/c '</c m)))
       #'<
-      #'high)]))
+      #'high
+      '</c)]))
 
 ;; only used by the opters
 (define (flat-contract/predicate? pred)
@@ -326,7 +340,8 @@
        #:stronger-ribs
        (append (optres-stronger-ribs optres-hd) (optres-stronger-ribs optres-tl))
        #:chaperone
-       (combine-two-chaperone?s (optres-chaperone optres-hd) (optres-chaperone optres-tl)))))
+       (combine-two-chaperone?s (optres-chaperone optres-hd) (optres-chaperone optres-tl))
+       #:name #`(list 'cons/c #,(optres-name optres-hd) #,(optres-name optres-tl)))))
   
   (syntax-case stx (cons/c)
     [(_ hdp tlp) (opt/cons-ctc #'hdp #'tlp)]))
@@ -374,7 +389,11 @@
          #f)
      #:opt #f
      #:stronger-ribs (optres-stronger-ribs optres-ele)
-     #:chaperone (optres-chaperone optres-ele))))
+     #:chaperone (optres-chaperone optres-ele)
+     #:name #`(list '#,(if non-empty?
+                           'non-empty-listof
+                           'listof)
+                    #,(optres-name optres-ele)))))
 
 (define/opter (listof opt/i opt/info stx)
   (syntax-case stx ()
@@ -392,7 +411,7 @@
   (define (opt/arrow-ctc doms rngs)
     (let*-values ([(dom-vars rng-vars) (values (generate-temporaries doms)
                                                (generate-temporaries rngs))]
-                  [(next-doms lifts-doms superlifts-doms partials-doms stronger-ribs-dom dom-chaperone?)
+                  [(next-doms lifts-doms superlifts-doms partials-doms stronger-ribs-dom dom-chaperone? dom-names)
                    (let loop ([vars dom-vars]
                               [doms doms]
                               [next-doms null]
@@ -400,14 +419,16 @@
                               [superlifts-doms null]
                               [partials-doms null]
                               [stronger-ribs null]
-                              [chaperone? #t])
+                              [chaperone? #t]
+                              [dom-names '()])
                      (cond
                        [(null? doms) (values (reverse next-doms)
                                              lifts-doms
                                              superlifts-doms
                                              partials-doms
                                              stronger-ribs 
-                                             chaperone?)]
+                                             chaperone?
+                                             (reverse dom-names))]
                        [else
                         (define optres-dom (opt/i (opt/info-swap-blame opt/info) (car doms)))
                         (loop (cdr vars)
@@ -421,8 +442,9 @@
                               (append superlifts-doms (optres-superlifts optres-dom))
                               (append partials-doms (optres-partials optres-dom))
                               (append (optres-stronger-ribs optres-dom) stronger-ribs)
-                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-dom)))]))]
-                  [(next-rngs lifts-rngs superlifts-rngs partials-rngs stronger-ribs-rng rng-chaperone?)
+                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-dom))
+                              (cons (optres-name optres-dom) dom-names))]))]
+                  [(next-rngs lifts-rngs superlifts-rngs partials-rngs stronger-ribs-rng rng-chaperone? rng-names)
                    (let loop ([vars rng-vars]
                               [rngs rngs]
                               [next-rngs null]
@@ -430,14 +452,16 @@
                               [superlifts-rngs null]
                               [partials-rngs null]
                               [stronger-ribs null]
-                              [chaperone? #t])
+                              [chaperone? #t]
+                              [rng-names '()])
                      (cond
                        [(null? rngs) (values (reverse next-rngs)
                                              lifts-rngs
                                              superlifts-rngs
                                              partials-rngs
                                              stronger-ribs
-                                             chaperone?)]
+                                             chaperone?
+                                             (reverse rng-names))]
                        [else
                         (define optres-rng (opt/i opt/info (car rngs)))
                         (loop (cdr vars)
@@ -451,7 +475,8 @@
                               (append superlifts-rngs (optres-superlifts optres-rng))
                               (append partials-rngs (optres-partials optres-rng))
                               (append (optres-stronger-ribs optres-rng) stronger-ribs)
-                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-rng)))]))])
+                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-rng))
+                              (cons (optres-name optres-rng) rng-names))]))])
       (values
        (with-syntax ((val (opt/info-val opt/info))
                      (blame (opt/info-blame opt/info))
@@ -482,11 +507,16 @@
        #f
        #f
        (append stronger-ribs-dom stronger-ribs-rng)
-       (combine-two-chaperone?s dom-chaperone? rng-chaperone?))))
+       (combine-two-chaperone?s dom-chaperone? rng-chaperone?)
+       #`(list '->
+               #,@dom-names
+               #,(if (= 1 (length rng-names))
+                     (car rng-names)
+                     #`(list 'values #,@rng-names))))))
   
   (define (opt/arrow-any-ctc doms)
     (let*-values ([(dom-vars) (generate-temporaries doms)]
-                  [(next-doms lifts-doms superlifts-doms partials-doms stronger-ribs-dom dom-chaperone?)
+                  [(next-doms lifts-doms superlifts-doms partials-doms stronger-ribs-dom dom-chaperone? names)
                    (let loop ([vars dom-vars]
                               [doms doms]
                               [next-doms null]
@@ -494,14 +524,16 @@
                               [superlifts-doms null]
                               [partials-doms null]
                               [stronger-ribs null]
-                              [chaperone? #t])
+                              [chaperone? #t]
+                              [names '()])
                      (cond
                        [(null? doms) (values (reverse next-doms)
                                              lifts-doms
                                              superlifts-doms
                                              partials-doms
                                              stronger-ribs
-                                             chaperone?)]
+                                             chaperone?
+                                             (reverse names))]
                        [else
                         (define optres-dom (opt/i (opt/info-swap-blame opt/info) (car doms)))
                         (loop (cdr vars)
@@ -512,7 +544,8 @@
                               (append superlifts-doms (optres-superlifts optres-dom))
                               (append partials-doms (optres-partials optres-dom))
                               (append (optres-stronger-ribs optres-dom) stronger-ribs)
-                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-dom)))]))])
+                              (combine-two-chaperone?s chaperone? (optres-chaperone optres-dom))
+                              (cons (optres-name optres-dom) names))]))])
       (values
        (with-syntax ((blame (opt/info-blame opt/info))
                      ((dom-arg ...) dom-vars)
@@ -532,7 +565,10 @@
        #f
        #f
        stronger-ribs-dom
-       dom-chaperone?)))
+       dom-chaperone?
+       #`(list '->
+               #,@names
+               'any))))
   
   (syntax-case* stx (-> values any any/c) module-or-top-identifier=?
     [(-> any/c ... any)
@@ -551,35 +587,39 @@
         #:flat #'(procedure-arity-includes? val n)
         #:opt #f
         #:stronger-ribs null
-        #:chaperone #t))]
+        #:chaperone #t
+        #:name #`'(-> #,@(build-list (syntax-e #'n) (λ (x) 'any/c)) any)))]
     [(-> dom ... (values rng ...))
      (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
          (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
-         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone?)
+         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone? name)
                        (opt/arrow-ctc (syntax->list (syntax (dom ...)))
                                       (syntax->list (syntax (rng ...))))])
            (if (eq? chaperone? #t)
                (build-optres #:exp next #:lifts lift #:superlifts superlift #:partials partial
-                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?)
+                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?
+                             #:name name)
                (opt/unknown opt/i opt/info stx))))]
     [(-> dom ... any)
      (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
          (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
-         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone?)
+         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone? name)
                        (opt/arrow-any-ctc (syntax->list (syntax (dom ...))))])
            (if (eq? chaperone? #t)
                (build-optres #:exp next #:lifts lift #:superlifts superlift #:partials partial
-                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?)
+                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?
+                             #:name name)
                (opt/unknown opt/i opt/info stx))))]
     [(-> dom ... rng)
      (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
          (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
-         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone?)
+         (let-values ([(next lift superlift partial flat opt stronger-ribs chaperone? name)
                        (opt/arrow-ctc (syntax->list (syntax (dom ...)))
                                       (list #'rng))])
            (if (eq? chaperone? #t)
                (build-optres #:exp next #:lifts lift #:superlifts superlift #:partials partial
-                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?)
+                             #:flat flat #:opt opt #:stronger-ribs stronger-ribs #:chaperone chaperone?
+                             #:name name)
                (opt/unknown opt/i opt/info stx))))]))
 
 (define (raise-flat-arrow-err blame val n)
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 4bc8bcde65..eeb27b9141 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -12274,7 +12274,7 @@ so that propagation occurs.
              (or/c integer? boolean?))
   (test-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?)
              (or/c (-> (>=/c 5) (>=/c 5)) boolean?))
-  (test-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?)
+  (test-name '(or/c boolean? (-> (>=/c 5) (>=/c 5)))
              (or/c boolean? (-> (>=/c 5) (>=/c 5))))
   (test-name '(or/c (-> (>=/c 5) (>=/c 5))
                     (-> (<=/c 5) (<=/c 5) (<=/c 5)))
@@ -12849,7 +12849,7 @@ so that propagation occurs.
                    (flat-contract boolean?)))
   (test-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?)
              (or/c (-> (>=/c 5) (>=/c 5)) boolean?))
-  (test-name '(or/c (-> (>=/c 5) (>=/c 5)) boolean?)
+  (test-name '(or/c boolean? (-> (>=/c 5) (>=/c 5)))
              (or/c boolean? (-> (>=/c 5) (>=/c 5))))