diff --git a/collects/tests/unstable/options.rkt b/collects/tests/unstable/options.rkt
index 99623891c9..849ec29913 100644
--- a/collects/tests/unstable/options.rkt
+++ b/collects/tests/unstable/options.rkt
@@ -77,7 +77,7 @@
              (test-suite "options"
                          
                          (test-suite "option/c"
-                                                                          
+                                     
                                      (test-contract-fail 
                                       "failed tester"
                                       (script
@@ -114,7 +114,7 @@
                                          (define f values))
                                        (require 'server))
                                       "ctc")
-                                                                         
+                                     
                                      (test-contract-fail 
                                       "failed option/c no invariant but immutable"
                                       (script
@@ -129,7 +129,7 @@
                                       "server"
                                       "an invariant keyword argument (based on presence of other keyword arguments)")
                                      
-                                      (test-contract-fail 
+                                     (test-contract-fail 
                                       "failed option/c no invariant but flat"
                                       (script
                                        (module server racket
@@ -206,7 +206,7 @@
                                        ((exercise-option f) 2 4)
                                        ((exercise-option f) 2))) 
                                      
-                                      (test-contract-fail
+                                     (test-contract-fail
                                       "fails with option/c on function with case-lambda"
                                       (script
                                        (module server racket
@@ -240,7 +240,7 @@
                                          (define vec #(1 2 3 4 5)))
                                        (require 'server))) 
                                      
-                                      (test-contract-fail
+                                     (test-contract-fail
                                       "failed derived invariant/c (immutable) "
                                       (script
                                        (module server racket
@@ -249,33 +249,33 @@
                                                    [vec (option/c 
                                                          any/c
                                                          #:invariant values
-                                                        #:immutable #t)]))
+                                                         #:immutable #t)]))
                                          (define vec (vector 1 2 3 4 5)))
                                        (module client racket
                                          (require unstable/options)
                                          (require 'server)
                                          (exercise-option vec))
                                        (require 'client))
-                                       "server") 
+                                      "server") 
                                      
-                                      (test-contract-fail
+                                     (test-contract-fail
                                       "failed derived invariant/c (procedure) "
                                       (script
                                        (module server racket
                                          (require unstable/options)
                                          (provide (contract-out 
                                                    [f (option/c 
-                                                         any/c
-                                                         #:invariant values)]))
+                                                       any/c
+                                                       #:invariant values)]))
                                          (define f values))
                                        (module client racket
                                          (require unstable/options)
                                          (require 'server)
                                          (exercise-option f))
                                        (require 'client))
-                                       "server")
-                                      
-                                       (test-fail 
+                                      "server")
+                                     
+                                     (test-fail 
                                       "failed option/c for struct (unbound struct id)"
                                       (script
                                        (module server racket
@@ -333,7 +333,310 @@
                                       "server"
                                       "a struct of type foo"))         
                          
-                         
+                         (test-suite "option/c with contract"
+                                     
+                                     (test-pass
+                                      "passes with simple procedure contract"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (require 'server)
+                                       (boo 42)))
+                                     
+                                     (test-contract-fail
+                                      "fails (negative) with simple procedure contract"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) 42))
+                                       (require 'server)
+                                       (boo 'wrong))
+                                      "top-level")
+                                     
+                                     (test-contract-fail
+                                      "fails (positive) with simple procedure contract"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) 'wrong))
+                                       (require unstable/options 'server)
+                                       (boo 42))
+                                      "server")
+                                     
+                                     (test-contract-fail 
+                                      "failed tester"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec 
+                                                    (option/c
+                                                     any/c
+                                                     #:with-contract #t
+                                                     #:tester sorted?)]))
+                                         (define vec (vector 1 3 2 4 5))
+                                         (define (sorted? vec)
+                                           (for/and ([el vec]
+                                                     [cel (vector-drop vec 1)])
+                                             (<= el cel))))
+                                       (require 'server))
+                                      "server"
+                                      "option contract tester")
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c with misbehaving tester (indy)"
+                                      (script
+                                       (module ctc racket
+                                         (require unstable/options)
+                                         (provide indy-ctc)
+                                         (define indy-ctc
+                                           (option/c
+                                            (-> number? number?)
+                                            #:with-contract #t 
+                                            #:tester (λ (f) (f 'foo)))))
+                                       (module server racket
+                                         (require unstable/options)
+                                         (require 'ctc)
+                                         (provide (contract-out [f indy-ctc]))
+                                         (define f values))
+                                       (require 'server))
+                                      "ctc")
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c no invariant but immutable"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec (option/c 
+                                                         any/c
+                                                         #:with-contract #t
+                                                         #:immutable #t)]))
+                                         (define vec (vector 1 2 3 4 5)))
+                                       (require 'server))
+                                      "server"
+                                      "an invariant keyword argument (based on presence of other keyword arguments)")
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c no invariant but flat"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec (option/c 
+                                                         any/c
+                                                         #:with-contract #t
+                                                         #:flat? #t)]))
+                                         (define vec (vector 1 2 3 4 5)))
+                                       (require 'server))
+                                      "server"
+                                      "an invariant keyword argument (based on presence of other keyword arguments)")
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c no invariant but flat and immutable"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec (option/c 
+                                                         any/c
+                                                         #:flat? #t
+                                                         #:with-contract #t
+                                                         #:immutable #t)]))
+                                         (define vec (vector 1 2 3 4 5)))
+                                       (require 'server))
+                                      "server"
+                                      "an invariant keyword argument (based on presence of other keyword arguments)")  
+                                     
+                                     (test-pass
+                                      "passes with option/c on function with keyword arguments"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [f (option/c 
+                                                       (-> number? #:more number? number?)
+                                                       #:with-contract #t)]))
+                                         (define (f x #:more y) y))
+                                       (require unstable/options)
+                                       (require 'server)
+                                       (f 2 #:more 3)
+                                       ((exercise-option f) 2 #:more 3))) 
+                                     
+                                     (test-pass
+                                      "passes with option/c on function with optional keyword arguments"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [f (option/c
+                                                       (->* (number?) (#:more number?) number?)
+                                                       #:with-contract #t)]))
+                                         (define (f x #:more [y 3]) y))
+                                       (require unstable/options)
+                                       (require 'server)
+                                       (f 2)
+                                       (f 2 #:more 4)
+                                       ((exercise-option f) 2 #:more 4)
+                                       ((exercise-option f) 2))) 
+                                     
+                                     (test-pass
+                                      "passes with option/c on function with case-lambda"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [f (option/c 
+                                                       (case-> 
+                                                        (-> number? number? number?)
+                                                        (-> number? number?))
+                                                       #:with-contract #t)]))
+                                         (define f (case-lambda 
+                                                     [(lo hi) (max lo hi)]
+                                                     [(single) single])))
+                                       (require unstable/options)
+                                       (require 'server)
+                                       (f 2)
+                                       (f 2 4)
+                                       ((exercise-option f) 2 4)
+                                       ((exercise-option f) 2))) 
+                                     
+                                     (test-contract-fail
+                                      "fails with option/c on function with case-lambda"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [f (option/c
+                                                       (case-> 
+                                                        (-> number? number? number?)
+                                                        (-> number? number?))
+                                                       #:with-contract #t)]))
+                                         (define f (case-lambda 
+                                                     [(lo hi) (max lo hi)]
+                                                     [(single) single])))
+                                       (require unstable/options)
+                                       (require 'server)
+                                       (f 2 "boo"))
+                                      "top-level") 
+                                     
+                                     (test-pass
+                                      "passes with option/c with invariant and flat and immutable"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec (option/c 
+                                                         any/c
+                                                         #:with-contract #t
+                                                         #:invariant values
+                                                         #:flat? #t
+                                                         #:immutable #t)]))
+                                         (define vec #(1 2 3 4 5)))
+                                       (require 'server))) 
+                                     
+                                     (test-contract-fail
+                                      "failed derived invariant/c (immutable) "
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [vec (option/c 
+                                                         any/c
+                                                         #:with-contract #t
+                                                         #:invariant values
+                                                         #:immutable #t)]))
+                                         (define vec (vector 1 2 3 4 5)))
+                                       (require 'server))
+                                      "server") 
+                                     
+                                     (test-contract-fail
+                                      "failed derived invariant/c (procedure) "
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [f (option/c 
+                                                       any/c
+                                                       #:with-contract #t
+                                                       #:invariant values)]))
+                                         (define f values))
+                                       (require 'server))
+                                      "server")
+                                     
+                                     (test-fail 
+                                      "failed option/c for struct (unbound struct id)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [s (option/c 
+                                                       any/c
+                                                       #:with-contract #t
+                                                       #:struct boo)]))
+                                         (struct foo (a b))
+                                         (define s (foo 2 2)))
+                                       (require 'server))
+                                      "expected a struct identifier") 
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c for struct (missing struct id)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [s (option/c any/c #:with-contract #t)]))
+                                         (struct foo (a b))
+                                         (define s (foo 2 2)))
+                                       (require 'server))
+                                      "server"
+                                      "a vector or a hash") 
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c for struct (wrong struct id)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [s (option/c 
+                                                       any/c
+                                                       #:struct boo
+                                                       #:with-contract #t)]))
+                                         (struct foo (a b))
+                                         (struct boo (a b))
+                                         (define s (foo 2 2)))
+                                       (require 'server))
+                                      "server"
+                                      "a struct of type boo")  
+                                     
+                                     (test-contract-fail 
+                                      "failed option/c for struct (vector for struct id)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out 
+                                                   [s (option/c 
+                                                       any/c
+                                                       #:struct foo               
+                                                       #:with-contract #t)]))
+                                         (struct foo (a b))
+                                         (define s (vector 2 2)))
+                                       (require 'server))                                      
+                                      "server"
+                                      "a struct of type foo"))
                          
                          (test-suite "transfer-option"
                                      
@@ -353,6 +656,102 @@
                                        (require unstable/options 'middle1)
                                        (boo 1)))
                                      
+                                     (test-pass
+                                      "passes after two transfers (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c 
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       (boo 1)))
+                                     
+                                     
+                                     
+                                     (test-contract-fail
+                                      "fails (positive) after one transfer (with-contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) 'wrong))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (require 'client)
+                                       (displayln (boo 42))
+                                       (boo 42))
+                                      (list "client" "server"))
+                                     
+                                     (test-contract-fail
+                                      "fails (negative) after one transfer (with-contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (require 'client)
+                                       (boo 'wrong))
+                                      (list "top-level" "client"))
+                                     
+                                     (test-contract-fail
+                                      "fails (positive) after two transfers (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c 
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) 'wrong))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       (boo 1))
+                                      (list "middle1" "middle0" "server")) 
+                                     
+                                     (test-contract-fail
+                                      "fails (negative) after two transfers (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo 
+                                                                 (option/c 
+                                                                  (-> number? number?)
+                                                                  #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       (boo 'wrong))
+                                      (list "top-level" "middle1" "middle0"))
+                                     
                                      (test-pass
                                       "passes after void transfer"
                                       (script
@@ -373,9 +772,9 @@
                                          (require unstable/options 'server)
                                          (provide (transfer-option boo)))
                                        (require 'client)
-                                         (boo 42)))
+                                       (boo 42)))
                                      
-                                      (test-pass
+                                     (test-pass
                                       "passes after void client's transfer after exercise"
                                       (script
                                        (module server racket
@@ -387,12 +786,26 @@
                                          (define e-boo (exercise-option boo))
                                          (provide (transfer-option e-boo)))
                                        (require 'client)
-                                         (e-boo 42))))
+                                       (e-boo 42)))
+                                     
+                                     (test-pass
+                                      "passes after void client's transfer after exercise (with-contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         (define e-boo (exercise-option boo))
+                                         (provide (transfer-option e-boo)))
+                                       (require 'client)
+                                       (e-boo 42))))
                          
                          (test-suite "exercise-option"
                                      
                                      (test-pass
-                                      "passes after two transfers and waive"
+                                      "passes after two transfers and exercise"
                                       (script
                                        (module server racket
                                          (require unstable/options)
@@ -405,7 +818,7 @@
                                          (require unstable/options 'middle0)
                                          (provide (transfer-option boo)))
                                        (require unstable/options 'middle1)
-                                       ((waive-option boo) 1)))
+                                       ((exercise-option boo) 1)))
                                      
                                      (test-contract-fail
                                       "positive contract failure after successful transfer and exercise"
@@ -470,13 +883,99 @@
                                          (require unstable/options 'server)
                                          (define e-boo (exercise-option boo))
                                          (provide (transfer-option e-boo)))
+                                       (require 'client)))
+                                     
+                                     
+                                     (test-pass
+                                      "passes after two transfers and exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((exercise-option boo) 1)))
+                                     
+                                     (test-contract-fail
+                                      "positive contract failure after successful transfer and exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) "wrong!"))
+                                       (module middle racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module client racket
+                                         (require unstable/options 'middle)
+                                         ((exercise-option boo) 42))
+                                       (require 'client))
+                                      (list "middle" "server"))   
+                                     
+                                     (test-contract-fail
+                                      "negative contract failure after successful transfer and exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module client racket
+                                         (require unstable/options 'middle)
+                                         ((exercise-option boo) "wrong!"))
+                                       (require 'client))
+                                      (list "client" "middle"))   
+                                     
+                                     
+                                     (test-contract-fail
+                                      "passes after exercise after succesful exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         ((exercise-option (exercise-option boo)) "error"))
+                                       (require 'client))
+                                      "client")
+                                     
+                                     (test-pass
+                                      "passes after transfer after succesful exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         (define e-boo (exercise-option boo))
+                                         (provide (transfer-option e-boo)))
                                        (require 'client))))
                          
                          
                          (test-suite "waive-option"
                                      
                                      (test-pass
-                                      "passes after two transfers and exercise"
+                                      "passes after two transfers and waive"
                                       (script
                                        (module server racket
                                          (require unstable/options)
@@ -489,7 +988,7 @@
                                          (require unstable/options 'middle0)
                                          (provide (transfer-option boo)))
                                        (require unstable/options 'middle1)
-                                       ((exercise-option boo) 1)))
+                                       ((waive-option boo) 1)))
                                      
                                      
                                      (test-pass
@@ -510,7 +1009,7 @@
                                        ((waive-option (waive-option boo)) "error")))
                                      
                                      (test-contract-fail
-                                      "passes with waive after succesful exercise"
+                                      "fails with waive after succesful exercise"
                                       (script
                                        (module server racket
                                          (require unstable/options)
@@ -523,7 +1022,7 @@
                                       "client")
                                      
                                      (test-pass
-                                      "passes transfer after succesful waive"
+                                      "passes with transfer after succesful waive"
                                       (script
                                        (module server racket
                                          (require unstable/options)
@@ -533,7 +1032,233 @@
                                          (require unstable/options 'server)
                                          (define e-boo (waive-option boo))
                                          (provide (transfer-option e-boo)))
-                                       (require 'client)))))
+                                       (require 'client)))
+                                     
+                                     (test-pass
+                                      "passes after two transfers and waive (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((waive-option boo) 1)))          
+                                     
+                                     
+                                     (test-pass
+                                      "passes after waive after succesful waive (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (require unstable/options 'server)
+                                       ((waive-option (waive-option boo)) "error")))
+                                     
+                                     (test-contract-fail
+                                      "fails with waive after succesful exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         ((waive-option (exercise-option boo)) "error"))
+                                       (require 'client))
+                                      "client")
+                                     
+                                     (test-pass
+                                      "passes with transfer after succesful waive (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         (define e-boo (waive-option boo))
+                                         (provide (transfer-option e-boo)))
+                                       (require 'client))))
+                         
+                         (test-suite "tweak-option"
+                                     
+                                     (test-pass
+                                      "passes after two transfers and tweak"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((tweak-option boo) 1)))
+                                     
+                                     (test-contract-fail
+                                      "fails (negative) after two transfers and tweak"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((tweak-option boo) 'wrong))
+                                      (list "top-level" "middle1" "middle0"))
+                                     
+                                     (test-contract-fail
+                                      "fails (positive) after two transfers and tweak"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) 'wrong))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((tweak-option boo) 42))
+                                      (list "middle1" "middle0" "server"))
+                                     
+                                     (test-contract-fail 
+                                      "passes after two transfers and tweak"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((tweak-option boo) 42)
+                                       ((tweak-option boo) 'wrong))
+                                      (list "top-level" "middle1" "middle0"))
+                                     
+                                     (test-pass
+                                      "passes after two transfers and tweak (with-contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module middle0 racket
+                                         (require unstable/options 'server)
+                                         (provide (transfer-option boo)))
+                                       (module middle1 racket
+                                         (require unstable/options 'middle0)
+                                         (provide (transfer-option boo)))
+                                       (require unstable/options 'middle1)
+                                       ((tweak-option boo) 1)))
+                                     
+                                     
+                                     
+                                     
+                                     (test-pass
+                                      "passes after tweak"
+                                      (script
+                                       (require unstable/options)
+                                       (define (boo x) x)
+                                       (tweak-option boo)))
+                                     
+                                     (test-pass
+                                      "fails after tweak after succesful tweak"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (require unstable/options 'server)
+                                       ((tweak-option (tweak-option boo)) "error")))
+                                     
+                                     (test-contract-fail
+                                      "fails after tweak after succesful tweak (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (require unstable/options 'server)
+                                       ((tweak-option (tweak-option boo)) "error"))
+                                      "top-level")
+                                      
+                                     
+                                     (test-contract-fail
+                                      "fails with tweak after succesful exercise"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         ((tweak-option (exercise-option boo)) "error"))
+                                       (require 'client))
+                                      "client")
+                                     
+                                     (test-contract-fail
+                                      "fails with exercise after tweak exercise"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c (-> number? number?))]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         ((exercise-option (tweak-option boo)) "error"))
+                                       (require 'client))
+                                      "client")
+                                     
+                                     (test-contract-fail
+                                      "fails with exercise after tweak exercise (with contract)"
+                                      (script
+                                       (module server racket
+                                         (require unstable/options)
+                                         (provide (contract-out [boo (option/c 
+                                                                      (-> number? number?)
+                                                                      #:with-contract #t)]))
+                                         (define (boo x) x))
+                                       (module client racket
+                                         (require unstable/options 'server)
+                                         ((exercise-option (tweak-option boo)) "error"))
+                                       (require 'client))
+                                      "client")))
+             
+             
              
              
              (test-suite "invariant/c"
diff --git a/collects/unstable/options.rkt b/collects/unstable/options.rkt
index c6f329c366..77d0d86ea3 100644
--- a/collects/unstable/options.rkt
+++ b/collects/unstable/options.rkt
@@ -1,8 +1,9 @@
 #lang racket
 
 
-(provide option/c transfer-option exercise-option waive-option invariant/c
-         has-option?)
+(provide option/c transfer-option exercise-option waive-option tweak-option
+         has-option? has-option-with-contract?
+         invariant/c)
 
 
 (require syntax/location 
@@ -55,54 +56,50 @@
       #t
       (andmap boolean? (third s-info))))
 
-(struct info (val proj blame))
+(struct info (val proj blame with))
 
 (define-values (impersonator-prop:proxy proxy? proxy-info) 
   (make-impersonator-property 'proxy))
 
-(struct proc-proxy (proc ctc proc-info)
-  #:property prop:procedure  (struct-field-index proc)
-  #:property prop:contracted (struct-field-index ctc))
 
-(define (build-proc-proxy ctc proc-info)
-  (let ((val (info-val proc-info)))
-    (proc-proxy
-     (if (object-name val)
-         (procedure-rename
-          val
-          (object-name val))
-       val)
-   ctc
-   proc-info)))
-
-
-(define (build-proxy ctc val proj blame)
-  (let ([proxy-info (info val proj blame)])
-    (cond [(procedure? val)
-           (build-proc-proxy ctc proxy-info)]
-          [(vector? val)
-           (chaperone-vector
-            val
-            (λ (v i val) val)
-            (λ (v i val) val)
-            impersonator-prop:contracted ctc
-            impersonator-prop:proxy proxy-info)]
-          [(hash? val)
-           (chaperone-hash
-            val
-            (λ (h k) (values k (λ (h k v) v)))
-            (λ (h k v) (values k v))
-            (λ (h k) k)
-            (λ (h k) k)
-            impersonator-prop:contracted ctc
-            impersonator-prop:proxy proxy-info)]
-          [else 
-           (chaperone-struct
-            val
-            (first (second (option-structid ctc)))
-            (λ (v f) f)
-            impersonator-prop:contracted ctc
-            impersonator-prop:proxy proxy-info)])))
+(define (build-proxy with ctc val proj blame)
+  (let* ([proxy-info (info val proj blame with)]
+         [ival
+          (cond [(procedure? val)
+                 (chaperone-procedure
+                  val
+                  (make-keyword-procedure
+                   (λ (kwds kwd-args . other-args)
+                       (apply values kwd-args other-args))
+                     (λ args
+                       (apply values args)))
+                  impersonator-prop:contracted ctc
+                  impersonator-prop:proxy proxy-info)]
+                [(vector? val)
+                 (chaperone-vector
+                  val
+                  (λ (v i val) val)
+                  (λ (v i val) val)
+                  impersonator-prop:contracted ctc
+                  impersonator-prop:proxy proxy-info)]
+                [(hash? val)
+                 (chaperone-hash
+                  val
+                  (λ (h k) (values k (λ (h k v) v)))
+                  (λ (h k v) (values k v))
+                  (λ (h k) k)
+                  (λ (h k) k)
+                  impersonator-prop:contracted ctc
+                  impersonator-prop:proxy proxy-info)]
+                [else 
+                 (chaperone-struct
+                  val
+                  (first (second (option-structid ctc)))
+                  (λ (v f) f)
+                  impersonator-prop:contracted ctc
+                  impersonator-prop:proxy proxy-info)])])
+    (cond [with ((proj blame) ival)]
+          [else ival])))
 
 
 (define (run-tester tester val orig-ctc blame here)
@@ -122,19 +119,22 @@
   (apply build-compound-type-name 'option/c 
          (contract-name (option-orig-ctc c))
          (append 
+          (if (option-with c)
+              (list '#:with-contract #t)
+              null)
           (if (eq? (option-tester c) 'dont-care)
               null
               (list '#:tester (option-tester c)))
           (if (eq? (option-flat c) #f)
               null
               (list '#:flat? #t))
-           (if (eq? (option-immutable c) 'dont-care)
+          (if (eq? (option-immutable c) 'dont-care)
               null
               (list '#:immutable (option-immutable c)))
-           (if (eq? (option-invariant c) 'dont-care)
+          (if (eq? (option-invariant c) 'dont-care)
               null
               (list '#:invariant (option-invariant c)))
-           (if (eq? (option-structid c) 'none)
+          (if (eq? (option-structid c) 'none)
               null
               (list '#:struct (fourth (option-structid c)))))))
 
@@ -150,11 +150,11 @@
     (when (and (eq? invariant 'dont-care)
                (or  (not (eq? immutable 'dont-care))
                     (not (eq? flat #f))))
-          (raise-blame-error 
-           blame
-           val
-           '(expected "an invariant keyword argument (based on presence of other keyword arguments)")))
-    (unless (or (and (procedure? val) (eq? structid 'none))
+      (raise-blame-error 
+       blame
+       val
+       '(expected "an invariant keyword argument (based on presence of other keyword arguments)")))
+    (unless (or (and (procedure? val) (not (parameter? val)) (eq? structid 'none))
                 (and (vector? val) (eq? structid 'none))
                 (and (hash? val) (eq? structid 'none))
                 (and (not (eq? structid 'none)) (same-type val structid)))
@@ -165,11 +165,11 @@
 
 
 (define (build-orig-proj c inv flat immutable structid here)
-  (cond [(eq? inv 'dont-care) (option-orig-ctc c)]
+  (cond [(eq? inv 'dont-care) c]
         [else
-         (invariantc (option-orig-ctc c) inv #:struct structid #:flat? flat #:immutable immutable here)]))
+         (invariantc c inv #:struct structid #:flat? flat #:immutable immutable here)]))
 
-(struct option (orig-ctc tester invariant  flat immutable structid here)
+(struct option (orig-ctc with tester invariant  flat immutable structid here)
   #:property prop:contract
   (build-contract-property
    #:name 
@@ -183,29 +183,31 @@
      (λ (blame)
        (λ (val)
          (check-option ctc val blame)
-         (let*  ([tester (option-tester ctc)]
+         (let*  ([with (option-with ctc)]
+                 [tester (option-tester ctc)]
                  [invariant (option-invariant ctc)]
                  [flat (option-flat ctc)]
                  [immutable (option-immutable ctc)]
                  [structid (option-structid ctc)]
                  [here (option-here ctc)]
                  [orig-ctc (option-orig-ctc ctc)]
-                 [exec-ctc (build-orig-proj ctc invariant flat immutable structid here)])
+                 [exec-ctc (build-orig-proj orig-ctc invariant flat immutable structid here)])
            (unless (symbol? tester)
              (run-tester tester val orig-ctc blame here))
-           (build-proxy ctc val (contract-projection exec-ctc)
+           (build-proxy with ctc val (contract-projection exec-ctc)
                         (blame-add-context
                          blame
                          "the option of"))))))))
 
 (define (build-option ctc
+                      #:with-contract [with #f]
                       #:tester [tester 'dont-care]
                       #:invariant [invariant 'dont-care] 
                       #:flat? [flat #f] 
                       #:immutable [immutable 'dont-care]
                       #:struct [structid 'none]
                       here)
-  (option ctc tester invariant flat immutable structid here))
+  (option ctc with tester invariant flat immutable structid here))
 
 
 
@@ -251,13 +253,7 @@
            (cond [(proxy? val)
                   (let ((info (proxy-info val)))
                     (build-proxy
-                     (value-contract val)
-                     (info-val info)
-                     (info-proj info)
-                     (blame-update (info-blame info) pos-blame neg-blame)))]
-                 [(proc-proxy? val)
-                  (let ((info (proc-proxy-proc-info val)))
-                    (build-proxy
+                     (info-with info)
                      (value-contract val)
                      (info-val info)
                      (info-proj info)
@@ -275,10 +271,10 @@
     [(transferc id) 
      (let ([this-one (gensym 'transfer-ctc)])
        (syntax-property
-          (syntax/loc stx
-            (transfer 'id))
-          'racket/contract:contract
-          (vector this-one null (list #'transferc))))]))
+        (syntax/loc stx
+          (transfer 'id))
+        'racket/contract:contract
+        (vector this-one null (list #'transferc))))]))
 
 (define-syntax transfer-option
   (make-provide-pre-transformer
@@ -302,22 +298,35 @@
   (and (has-contract? val) 
        (option? (value-contract val))))
 
+(define (has-option-with-contract? val)
+  (and (has-contract? val) 
+       (option? (value-contract val))
+       (info-with (proxy-info val))))
+
+(define (tweak-option val)
+  (cond [(proxy? val)
+         (let ((info (proxy-info val)))
+           (build-proxy
+            (not (info-with info))
+            (value-contract val)
+            (info-val info)
+            (info-proj info)
+            (info-blame info)))]
+        [else val]))
+
 (define (exercise-option val)
-  (cond [(and (has-contract? val) (option? (value-contract val)))
-         (let ((info (cond [(proxy? val)  (proxy-info val)]
-                           [else (proc-proxy-proc-info val)])))
+  (cond [(proxy? val)
+         (let ([info (proxy-info val)])
            (((info-proj info)
              (info-blame info))
             (info-val info)))]
         [else val]))
 
 (define (waive-option val)
-  (cond [(and (has-contract? val) (option? (value-contract val)))
-         (cond [(proxy? val) (info-val (proxy-info val))]
-               [else (info-val (proc-proxy-proc-info val))])]
+  (cond [(proxy? val) (info-val (proxy-info val))]
         [else val]))
 
-                           
+
 
 ;                                                                                                                
 ;                                                                                                                
@@ -473,14 +482,14 @@
                                             (if (procedure? first)
                                                 (list* first a-wrap rest)
                                                 rest))
-                                            '()
-                                            (second s-info))]
+                                          '()
+                                          (second s-info))]
                 [wrapped-mutators (foldr (λ (first rest) 
                                            (if (procedure? first)
                                                (list* first (m-wrap first) rest)
                                                rest))
-                                           '()
-                                           (third s-info))]
+                                         '()
+                                         (third s-info))]
                 [struct-wrapper
                  (λ (wrapper) 
                    (apply
@@ -508,13 +517,13 @@
           (λ (val)
             (check val raise-blame #f)
             (unless (invariant (((contract-projection orig-ctc) indy-blame) val))
-             (let ([kind (cond [(vector? val) 'vector]
-                               [(hash? val) 'hash]
-                               [else 'struct])])  
-               (raise-blame-error 
-                blame
-                val
-                (format "expected ~s that satisfies ~s given: ~e" kind invariant val))))
+              (let ([kind (cond [(vector? val) 'vector]
+                                [(hash? val) 'hash]
+                                [else 'struct])])  
+                (raise-blame-error 
+                 blame
+                 val
+                 (format "expected ~s that satisfies ~s given: ~e" kind invariant val))))
             (build-inv-proxy ctc val invariant proj blame indy-blame impersonate?)))))))
 
 
diff --git a/collects/unstable/scribblings/options.scrbl b/collects/unstable/scribblings/options.scrbl
index 8552ccf9b7..a805b96f56 100644
--- a/collects/unstable/scribblings/options.scrbl
+++ b/collects/unstable/scribblings/options.scrbl
@@ -10,6 +10,7 @@
 @defmodule[unstable/options]
 
 @defproc[(option/c [c contract?]
+                   [#:with-contract with boolean? #f]
                    [#:tester tester (or/c (-> any boolean?) 'dont-care) 'dont-care]
                    [#:invariant invariant (or/c (-> any boolean?) 'dont-care) 'dont-care]
                    [#:immutable immutable (or/c #t #f 'dont-care) 'dont-care]
@@ -22,8 +23,12 @@ struct @racket[struct-id]. The data structure must match @racket[c] and pass the
 @racket[tester]. 
 
 When an @racket[option/c] contract is attached to a value, the value is checked against the 
-@racket[tester], if @racket[tester] is a predicate. After that, contract checking is disabled for the value.
+@racket[tester], if @racket[tester] is a predicate. After that,
+contract checking is disabled for the value, if @racket[with] is @racket[#f]. If @racket[with]
+is @racket[#t] contract checking for the value remains enabled for @racket[c].
 
+If @racket[waive-option] is applied to a value guarded by an @racket[option/c]
+contract, then @racket[waive-option] returns the value after removing the @racket[option/c] guard.
 If @racket[exercise-option] is applied to a value guarded by an @racket[option/c]
 contract, then @racket[exercise-option] returns the value with contract checking 
 enabled for @racket[c]. If the @racket[invariant] argument is a predicate, then 
@@ -51,6 +56,15 @@ is a predicate. In any other case, the result is a contract error.
 (vector-ref vec 1)
 
 (module server1 racket
+  (require unstable/options)
+  (provide 
+   (contract-out 
+    [vec (option/c (vectorof number?) #:with-contract #t)]))
+  (define vec (vector 1 2 3 4)))
+(require 'server1)
+(vector-set! vec 1 'foo)
+
+(module server2 racket
   (require unstable/options)
   (provide 
    (contract-out 
@@ -60,24 +74,25 @@ is a predicate. In any other case, the result is a contract error.
     (for/and ([el vec]
               [cel (vector-drop vec 1)])
              (<= el cel))))
-(require 'server1)
+(require 'server2)
 ]  
 
 
 }
 
-@defproc[(exercise-option [x has-option?]) any/c]{
+@defproc[(exercise-option [x any/c]) any/c]{
 
 Returns @racket[x] with contract ckecking enabled if an @racket[option/c] guards
-@racket[x]. In any other case it returns @racket[x].                                          
+@racket[x]. In any other case it returns @racket[x]. The result of @racket[exercise-option]
+loses the guard related to @racket[option/c], if it has one to begin with, and thus its contract checking status cannot change further.
                                             
 @defexamples[
 #:eval the-eval
-(module server2 racket
+(module server3 racket
   (require unstable/options)
   (provide (contract-out [foo (option/c (-> number? symbol?))]))
   (define foo (λ (x) x)))
-(require 'server2 unstable/options)
+(require 'server3 unstable/options)
 (define e-foo (exercise-option foo))
 (foo 42)
 (e-foo 'wrong)
@@ -101,49 +116,80 @@ each @racket[id] is provided from the module as usual.
 
  @defexamples[
 #:eval the-eval
-(module server3 racket
+(module server4 racket
   (require unstable/options)
   (provide (contract-out [foo (option/c (-> number? symbol?))]))
   (define foo (λ (x) x)))
 (module middleman racket
-  (require unstable/options 'server3)
+  (require unstable/options 'server4)
   (provide (transfer-option foo)))
 (require 'middleman unstable/options)
 (define e-foo (exercise-option foo))
 (e-foo 1)
 (e-foo 'wrong)
-(module server4 racket
+(module server5 racket
   (require unstable/options)
   (provide [transfer-option boo])
   (define (boo x) x))
-(require 'server4)
+(require 'server5)
 (boo 42)] 
 
 
 
-@defproc[(waive-option [x has-option?]) any/c]{ 
+@defproc[(waive-option [x any/c]) any/c]{ 
 
 If an @racket[option/c] guards @racket[x], then @racket[waive-option] returns 
 @racket[x] without the @racket[option/c] guard. 
-In any other case it returns @racket[x].
+In any other case it returns @racket[x]. The result of @racket[waive-option]
+loses the guard related to @racket[option/c], if it had one to begin with, and thus its contract checking status cannot change further.
 
 @defexamples[
 #:eval the-eval
-(module server5 racket
+(module server6 racket
   (require unstable/options)
   (provide (contract-out [bar (option/c (-> number? symbol?))]))
   (define bar (λ (x) x)))
-(require 'server5 unstable/options)
+(require 'server6 unstable/options)
 (define e-bar (waive-option bar))
 (e-bar 'wrong)
-((waive-option e-bar) 42)]  
+((waive-option e-bar) 'wrong)]  
 }    
 
+@defproc[(tweak-option [x any/c]) any/c]{ 
+
+If an @racket[option/c] guards @racket[x] and contract checking for @racket[x] is enabled, 
+then @racket[tweak-option] returns 
+@racket[x] with contract checking for @racket[x] disabled. 
+If an @racket[option/c] guards @racket[x] and contract checking for @racket[x] is disabled, 
+then @racket[tweak-option] returns 
+@racket[x] with contract checking for @racket[x] enabled. 
+In any other case it returns @racket[x]. The result of @racket[tweak-option]
+retains the guard related to @racket[option/c] if it has one to begin with and thus its contract checking status can change further
+using @racket[tweak-option], @racket[exercise-option] or @racket[waive-option].
+
+@defexamples[
+#:eval the-eval
+(module server7 racket
+  (require unstable/options)
+  (provide (contract-out [bar (option/c (-> number? symbol?))]))
+  (define bar (λ (x) x)))
+(require 'server7 unstable/options)
+(define t-bar (tweak-option bar))
+(t-bar 'wrong)
+((tweak-option t-bar) 'wrong)
+((waive-option t-bar) 'wrong)
+((exercise-option t-bar) 'wrong)
+]  
+}    
+ 
+ 
 @defproc[(has-option? [v any/c]) boolean?]{
   Returns @racket[#t] if @racket[v] has an option contract.
 }
 
-
+@defproc[(has-option-with-contract? [v any/c]) boolean?]{
+  Returns @racket[#t] if @racket[v] has an option contract with contract checking enabled.
+}
 
 @defproc[(invariant/c [c contract?]
                    [invariant (-> any boolean?)]
@@ -168,7 +214,7 @@ are chaperone contracts, then the result will be a chaperone contract.
 
 @defexamples[
 #:eval the-eval
-(module server6 racket
+(module server8 racket
    (require unstable/options)
    (provide
      change
@@ -182,7 +228,7 @@ are chaperone contracts, then the result will be a chaperone contract.
     (for/and ([el vec]
               [cel (vector-drop vec 1)])
       (<= el cel))))
-(require 'server6)
+(require 'server8)
 (vector-set! vec 2 42)
 (change)
 (vector-ref vec 2)]