give pair? the same treament as list? got in 9ee9f676

racket/collects/racket/contract/private/guts.rkt

@@ -52,7 +52,7 @@
          contract-custom-write-property-proc
          (rename-out [contract-custom-write-property-proc custom-write-property-proc])
          
-         set-listof-any!)
+         set-listof-any-and-cons/c-anyany!)
 
 (define (contract-custom-write-property-proc stct port display?)
   (write-string "#<" port)
@@ -219,7 +219,10 @@
 ;; the files are not set up for that, so we just
 ;; bang it in here and use it only after it's been banged in.
 (define listof-any #f)
-(define (set-listof-any! c) (set! listof-any c))
+(define consc-anyany #f)
+(define (set-listof-any-and-cons/c-anyany! l p)
+  (set! listof-any l)
+  (set! consc-anyany p))
 
 (define (coerce-contract/f x [name name-default])
   (define (coerce-simple-value x)
@@ -228,6 +231,7 @@
       [(and (procedure? x) (procedure-arity-includes? x 1))
        (cond
          [(and (eq? x list?) listof-any) listof-any]
+         [(and (eq? x pair?) consc-anyany) consc-anyany]
          [else
           (make-predicate-contract (if (name-default? name)
                                        (or (object-name x) '???)

racket/collects/racket/contract/private/misc.rkt

@@ -886,7 +886,11 @@
 (define (cons/c-name ctc)
   (define ctc-car (the-cons/c-hd-ctc ctc))
   (define ctc-cdr (the-cons/c-tl-ctc ctc))
-  (build-compound-type-name 'cons/c ctc-car ctc-cdr))
+  (cond
+    [(and (any/c? ctc-car) (any/c? ctc-cdr))
+     'pair?]
+    [else
+     (build-compound-type-name 'cons/c ctc-car ctc-cdr)]))
 
 (define (cons/c-stronger? this that) 
   (define this-hd (the-cons/c-hd-ctc this))
@@ -1959,5 +1963,5 @@
      [else "th"])))
 
 ;; this is a hack to work around cyclic linking issues;
-;; see definition of set-listof-any!
-(set-listof-any! (listof any/c))
+;; see definition of set-listof-any-and-cons/c-anyany!
+(set-listof-any-and-cons/c-anyany! (listof any/c) (cons/c any/c any/c))