diff --git a/collects/racket/contract/private/basic-opters.rkt b/collects/racket/contract/private/basic-opters.rkt
index 4cf0d69669..4814d07419 100644
--- a/collects/racket/contract/private/basic-opters.rkt
+++ b/collects/racket/contract/private/basic-opters.rkt
@@ -29,6 +29,7 @@
 ;;
 (define/opter (false/c opt/i opt/info stx) (opt/pred opt/info #'not #:name '#f))
 (define/opter (not opt/i opt/info stx) (opt/pred opt/info #'not))
+(define/opter (contract? opt/i opt/info stx) (opt/pred opt/info #'contract?))
 
 ;;
 ;; flat-contract helper
diff --git a/collects/racket/contract/private/object.rkt b/collects/racket/contract/private/object.rkt
index 7856d050d6..fe19cd8823 100644
--- a/collects/racket/contract/private/object.rkt
+++ b/collects/racket/contract/private/object.rkt
@@ -4,6 +4,9 @@
          "guts.rkt"
          "prop.rkt"
          "misc.rkt"
+         "opt.rkt"
+         "blame.rkt"
+         (for-syntax "opt-guts.rkt")
          racket/private/class-internal
          racket/stxparam)
 
@@ -116,11 +119,7 @@
       %/<%>)]))
 
 (define (is-a?/c <%>)
-  (unless (or (interface? <%>) (class? <%>))
-    (raise-argument-error
-     'is-a?/c
-     (format "~s" '(or/c interface? class?))
-     <%>))
+  (check-is-a?/c <%>)
   (define name (object-name <%>))
   (flat-named-contract
    (cond
@@ -132,3 +131,43 @@
    (lambda (x) (is-a? x <%>))))
 
 (define mixin-contract (->i ([c% class?]) [res (c%) (subclass?/c c%)]))
+
+
+(define/opter (is-a?/c opt/i opt/info stx)
+  (syntax-case stx ()
+    [(_ cls) 
+     (let ()
+       (define-values (lift-cls lifts1) (lift/binding #'cls 'is-a?/c-cls empty-lifts))
+       (with-syntax ([cls-x lift-cls])
+         (define lifts2 (lift/effect #'(check-is-a?/c cls-x) lifts1))
+         (with-syntax ([val (opt/info-val opt/info)]
+                       [ctc (opt/info-contract opt/info)]
+                       [blame (opt/info-blame opt/info)]
+                       [this (opt/info-this opt/info)]
+                       [that (opt/info-that opt/info)])
+           (build-optres
+            #:exp #'(if (is-a? val cls-x)
+                        val
+                        (raise-is-a?/c-error val cls-x blame))
+            #:lifts lifts2
+            #:superlifts null
+            #:partials null
+            #:flat #'(is-a? cls-x val)
+            #:opt #f
+            #:stronger-ribs '()
+            #:chaperone #t
+            #:name #'`(is-a?/c ,(object-name cls-x))))))]
+    [_ (opt/unknown opt/i opt/info stx)]))
+
+(define (raise-is-a?/c-error val cls-x blame)
+  (raise-blame-error blame val
+                     '(expected: "a class matching ~e" given: "~e")
+                     cls-x val))
+
+(define (check-is-a?/c <%>)
+  (unless (or (interface? <%>) (class? <%>))
+    (raise-argument-error
+     'is-a?/c
+     (format "~s" '(or/c interface? class?))
+     <%>)))
+  
\ No newline at end of file
diff --git a/collects/racket/contract/private/opt-guts.rkt b/collects/racket/contract/private/opt-guts.rkt
index 54f93eba56..924bc70d68 100644
--- a/collects/racket/contract/private/opt-guts.rkt
+++ b/collects/racket/contract/private/opt-guts.rkt
@@ -277,14 +277,20 @@
      #:chaperone #'(chaperone-contract? lift-var)
      #:name #'(contract-name lift-var))))
 
+(define unknown-contract-logger (make-logger 'racket/contract (current-logger)))
 (define (log-unknown-contract-warning exp [extra-warning ""])
-  (log-warning (string-append (format "warning in ~a:~a: opt/c doesn't know the contract ~s" 
-                                      (syntax-source exp)
-                                      (if (syntax-line exp)
-                                          (format "~a:~a" (syntax-line exp) (syntax-column exp))
-                                          (format ":~a" (syntax-position exp)))
-                                      (syntax->datum exp))
-                              extra-warning)))
+  (when (log-level? unknown-contract-logger 'warning)
+    (define datum (syntax->datum exp))
+    (log-message unknown-contract-logger
+                 'warning 
+                 (string-append (format "warning in ~a:~a: opt/c doesn't know the contract ~s" 
+                                        (syntax-source exp)
+                                        (if (syntax-line exp)
+                                            (format "~a:~a" (syntax-line exp) (syntax-column exp))
+                                            (format ":~a" (syntax-position exp)))
+                                        datum)
+                                extra-warning)
+                 datum)))
 
 
 (define opt-error-name (make-parameter 'opt/c))
diff --git a/collects/racket/contract/private/opt.rkt b/collects/racket/contract/private/opt.rkt
index a6a070ce46..52da4fdd0c 100644
--- a/collects/racket/contract/private/opt.rkt
+++ b/collects/racket/contract/private/opt.rkt
@@ -12,23 +12,28 @@
 (provide opt/c define-opt/c define/opter
          opt/direct 
          begin-lifted
+         raise-opt/pred-error
          (for-syntax
           opt/pred
           define-opt/recursive-fn?
           define-opt/recursive-fn-neg-blame?-id))
 
-(define-syntax (define/opter stx)
-  (syntax-case stx ()
+(define-syntax (define/opter orig-stx)
+  (syntax-case orig-stx ()
     [(_ (for opt/i opt/info stx) expr ...)
      (if (identifier? #'for)
-         #'(begin
-             (begin-for-syntax
-               (reg-opter!
-                #'for
-                (λ (opt/i opt/info stx)
-                  expr ...)))
-             (void))
-         (error 'define/opter "expected opter name to be an identifier, got ~.s" (syntax-e #'for)))]))
+         (with-syntax ([for/name (datum->syntax #'for
+                                                (string->symbol (format "~a/opter" (syntax-e #'for))))])
+           #'(begin
+               (begin-for-syntax
+                 (reg-opter!
+                  #'for
+                  (let ([for/name (λ (opt/i opt/info stx) expr ...)])
+                    for/name)))
+               (void)))
+         (raise-syntax-error 'define/opter "expected opter name to be an identifier"
+                             orig-stx
+                             #'for))]))
 
 ;;
 ;; opt/recursive-call
diff --git a/collects/racket/contract/private/opters.rkt b/collects/racket/contract/private/opters.rkt
index 54c761ff93..0711687e04 100644
--- a/collects/racket/contract/private/opters.rkt
+++ b/collects/racket/contract/private/opters.rkt
@@ -162,14 +162,14 @@
                          (that (opt/info-that opt/info)))
              (build-optres
               #:exp
-              (syntax (if (and (number? val) (<= n val m)) 
+              (syntax (if (and (real? val) (<= n val m)) 
                           val
                           (raise-opt-between/c-error
                            blame val n m)))
               #:lifts lifts3
               #:superlifts null
               #:partials null
-              #:flat (syntax (and (number? val) (<= n val m)))
+              #:flat (syntax (and (real? val) (<= n val m)))
               #:opt #f
               #:stronger-ribs
               (list (new-stronger-var
@@ -185,7 +185,8 @@
                                      [that that])
                          (syntax (<= this that))))))
               #:chaperone #t
-              #:name #''(between/c n m))))))]))
+              #:name #''(between/c n m))))))]
+    [_ (opt/unknown opt/i opt/info stx)]))
 
 (define (raise-opt-between/c-error blame val lo hi)
   (raise-blame-error
@@ -194,8 +195,9 @@
    '(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 name)
-  (with-syntax ([comparison comparison])
+(define-for-syntax (single-comparison-opter opt/info stx check-arg comparison arg name predicate?)
+  (with-syntax ([comparison comparison]
+                [predicate? predicate?])
     (let*-values ([(lift-low lifts2) (lift/binding arg 'single-comparison-val empty-lifts)])
       (with-syntax ([m lift-low])
         (let ([lifts3 (lift/effect (check-arg #'m) lifts2)])
@@ -207,13 +209,13 @@
             (build-optres
              #:exp
              (syntax 
-              (if (and (real? val) (comparison val m)) 
+              (if (and (predicate? val) (comparison val m)) 
                   val
-                  (raise-opt-single-comparison-opter-error blame val comparison m)))
+                  (raise-opt-single-comparison-opter-error blame val comparison m predicate?)))
              #:lifts lifts3
              #:superlifts null
              #:partials null
-             #:flat (syntax (and (number? val) (comparison val m)))
+             #:flat (syntax (and (predicate? val) (comparison val m)))
              #:opt #f
              #:stronger-ribs
              (list (new-stronger-var
@@ -225,11 +227,14 @@
              #:chaperone #t
              #:name #`'(#,name m))))))))
 
-(define (raise-opt-single-comparison-opter-error blame val comparison m)
+(define (raise-opt-single-comparison-opter-error blame val comparison m predicate?)
   (raise-blame-error
    blame
    val
-   '(expected: "a number ~a ~a" given: "~e")
+   '(expected: "a ~anumber ~a ~a" given: "~e")
+   (if (equal? predicate? real?)
+       "real "
+       "")
    (object-name comparison) m val))
 
 
@@ -243,7 +248,8 @@
                #'(check-unary-between/c '=/c m)))
       #'=
       #'x
-      '=/c)]))
+      '=/c
+      #'number?)]))
 
 (define/opter (>=/c opt/i opt/info stx)
   (syntax-case stx (>=/c)
@@ -255,7 +261,8 @@
                #'(check-unary-between/c '>=/c m)))
       #'>=
       #'low
-      '>=/c)]))
+      '>=/c
+      #'real?)]))
 
 (define/opter (<=/c opt/i opt/info stx)
   (syntax-case stx (<=/c)
@@ -267,7 +274,8 @@
                #'(check-unary-between/c '<=/c m)))
       #'<=
       #'high
-      '<=/c)]))
+      '<=/c
+      #'real?)]))
 
 (define/opter (>/c opt/i opt/info stx)
   (syntax-case stx (>/c)
@@ -279,7 +287,8 @@
                #'(check-unary-between/c '>/c m)))
       #'>
       #'low
-      '>/c)]))
+      '>/c
+      #'real?)]))
 
 (define/opter (</c opt/i opt/info stx)
   (syntax-case stx (</c)
@@ -291,7 +300,8 @@
                #'(check-unary-between/c '</c m)))
       #'<
       #'high
-      '</c)]))
+      '</c
+      #'real?)]))
 
 (define/opter (cons/c opt/i opt/info stx)
   (define (opt/cons-ctc hdp tlp)
@@ -398,6 +408,46 @@
     [(_ content) (opt/listof-ctc #'content #t opt/i opt/info)]))
 
 
+(define-for-syntax (predicate/c-optres opt/info)
+  (build-optres
+   #:exp
+   (with-syntax ((val (opt/info-val opt/info))
+                 (ctc (opt/info-contract opt/info))
+                 (blame (opt/info-blame opt/info)))
+     (syntax (if (struct-predicate-procedure? val)
+                 val
+                 (if (procedure? val)
+                     (let ([exact-proc
+                            (case-lambda
+                              [(dom-arg)
+                               (values
+                                (case-lambda
+                                  [(rng-arg)
+                                   (if (boolean? rng-arg)
+                                       rng-arg
+                                       (raise-opt/pred-error blame val 'boolean?))]
+                                  [args 
+                                   (bad-number-of-results blame val 1 args)])
+                                dom-arg)]
+                              [args
+                               (bad-number-of-arguments blame val args 1)])])
+                       (if (and (equal? (procedure-arity val) 1)
+                                (let-values ([(a b) (procedure-keywords val)])
+                                  (null? b)))
+                           (chaperone-procedure val exact-proc)
+                           (if (procedure-arity-includes? val 1)
+                               (handle-non-exact-procedure val 1 blame exact-proc)
+                               (raise-flat-arrow-err blame val 1))))
+                     (raise-flat-arrow-err blame val 1)))))
+   #:lifts null
+   #:superlifts null
+   #:partials null
+   #:flat #'(or (struct-predicate-procedure? val) (and (procedure? val) (procedure-arity-includes? val 1)))
+   #:opt #f
+   #:stronger-ribs null
+   #:chaperone #t
+   #:name #''predicate/c))
+
 ;;
 ;; arrow opter
 ;;
@@ -570,7 +620,7 @@
                #,@names
                'any))))
   
-  (syntax-case* stx (-> values any any/c) module-or-top-identifier=?
+  (syntax-case* stx (-> values any any/c boolean?) module-or-top-identifier=?
     [(-> any/c ... any)
      (with-syntax ([n (- (length (syntax->list stx)) 2)])
        (build-optres
@@ -578,17 +628,20 @@
         (with-syntax ((val (opt/info-val opt/info))
                       (ctc (opt/info-contract opt/info))
                       (blame (opt/info-blame opt/info)))
-          (syntax (if (procedure-arity-includes? val n)
+          (syntax (if (and (procedure? val) 
+                           (procedure-arity-includes? val n))
                       val
                       (raise-flat-arrow-err blame val n))))
         #:lifts null
         #:superlifts null
         #:partials null
-        #:flat #'(procedure-arity-includes? val n)
+        #:flat #'(and (procedure? val) (procedure-arity-includes? val n))
         #:opt #f
         #:stronger-ribs null
         #:chaperone #t
         #:name #`'(-> #,@(build-list (syntax-e #'n) (λ (x) 'any/c)) any)))]
+    [(-> any/c boolean?)
+     (predicate/c-optres opt/info)]
     [(-> 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 
@@ -622,6 +675,8 @@
                              #:name name)
                (opt/unknown opt/i opt/info stx))))]))
 
+(define/opter (predicate/c opt/i opt/info stx) (predicate/c-optres opt/info))
+
 (define (handle-non-exact-procedure val dom-len blame exact-proc)
   (check-procedure val #f dom-len 0 '() '() blame)
   (chaperone-procedure
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 9df1541773..3c9decbe03 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -199,20 +199,22 @@
        '(begin ,sexp (void)))))
 
   (define (test-flat-contract contract pass fail)
-    (define (run-three-tests contract)
+    (contract-eval `(,test #t flat-contract? ,contract))
+    (define (run-two-tests maybe-rewrite)
       (let ([name (if (pair? contract)
                       (car contract)
                       contract)])
-        (contract-eval `(,test #t flat-contract? ,contract))
-        (test/spec-failed (format "~a fail" name)
-                          `(contract ,contract ',fail 'pos 'neg)
-                          'pos)
-        (test/spec-passed/result
-         (format "~a pass" name)
-         `(contract ,contract ',pass 'pos 'neg)
-         pass)))
-    (run-three-tests contract)
-    (let/ec k (run-three-tests (rewrite contract k))))
+        (let/ec k
+          (test/spec-failed (format "~a fail" name)
+                            (maybe-rewrite `(contract ,contract ',fail 'pos 'neg) k)
+                            'pos))
+        (let/ec k
+          (test/spec-passed/result
+           (format "~a pass" name)
+           (maybe-rewrite `(contract ,contract ',pass 'pos 'neg) k)
+           pass))))
+    (run-two-tests (λ (x k) x))
+    (run-two-tests rewrite))
 
   (define-syntax (test-name stx)
     (syntax-case stx ()
@@ -1204,6 +1206,10 @@
               (make-keyword-procedure void)
               'pos 'neg))
 
+  (test/pos-blame
+   'contract-arrow-non-function
+   '(contract (-> any/c any) 1 'pos 'neg))
+  
   (test/spec-passed
    'contract-arrow-all-kwds2
    '((contract (-> #:a string? void?)
@@ -11562,27 +11568,25 @@
   ;; evaluates the exp and returns the number of opt/c warnings found
   (contract-eval
    '(define (eval-and-count-log-messages exp)
-      (define my-logger (make-logger))
-      (parameterize ([current-logger my-logger])
-        (define ans (make-channel))
-        (define recv (make-log-receiver my-logger 'warning))
-        (thread
-         (λ ()
-           (let loop ([opt/c-msgs 0])
-             (define res (sync recv))
-             (cond
-               [(equal? "done" (vector-ref res 1))
-                (channel-put ans opt/c-msgs)]
-               [else
-                (define opt/c-msg? (regexp-match? #rx"opt/c" (vector-ref res 1)))
-                (loop (if opt/c-msg?
-                          (+ opt/c-msgs 1)
-                          opt/c-msgs))]))))
-        (let/ec k
-          (parameterize ([error-escape-handler k])
-            (eval exp)))
-        (log-warning "done")
-        (channel-get ans))))
+      (define ans (make-channel))
+      (define recv (make-log-receiver (current-logger) 'warning))
+      (thread
+       (λ ()
+         (let loop ([opt/c-msgs 0])
+           (define res (sync recv))
+           (cond
+             [(equal? "done" (vector-ref res 1))
+              (channel-put ans opt/c-msgs)]
+             [else
+              (define opt/c-msg? (regexp-match? #rx"opt/c" (vector-ref res 1)))
+              (loop (if opt/c-msg?
+                        (+ opt/c-msgs 1)
+                        opt/c-msgs))]))))
+      (let/ec k
+        (parameterize ([error-escape-handler k])
+          (eval exp)))
+      (log-warning "done")
+      (channel-get ans)))
 
   (ctest 1 eval-and-count-log-messages
          '(let ()
@@ -12085,7 +12089,8 @@ so that propagation occurs.
   (test-flat-contract 'natural-number/c #e3 #i3.0)
   (test-flat-contract 'natural-number/c 0 -1)
   (test-flat-contract 'false/c #f #t)
-
+  (test-flat-contract 'contract? #f (λ (x y) 'whatever))
+  
   (test-flat-contract #t #t "x")
   (test-flat-contract #f #f "x")
   (test-flat-contract #\a #\a #\b)
@@ -12184,7 +12189,14 @@ so that propagation occurs.
                       (let ([ht (make-hash)])
                         (hash-set! ht 'x 1)
                         ht))
-
+  
+  (test-flat-contract '(between/c 1 10) 3 11)
+  (test-flat-contract '(between/c 1 10) 4 1+1i)
+  (test-flat-contract '(<=/c 1) 0 1+1i)
+  (test-flat-contract '(</c 1) 0 1+1i)
+  (test-flat-contract '(>/c 1) 4 1+1i)
+  (test-flat-contract '(>=/c 1) 4 1+1i)
+  
   (test #t 'malformed-binder
         (with-handlers ((exn? exn:fail:syntax?))
           (contract-eval '(flat-murec-contract ([(x) y]) x))