diff --git a/collects/racket/contract.rkt b/collects/racket/contract.rkt
index c6813bd63f..6a4d090b99 100644
--- a/collects/racket/contract.rkt
+++ b/collects/racket/contract.rkt
@@ -5,10 +5,12 @@
          "contract/region.rkt"
          "contract/private/basic-opters.rkt"
          "contract/private/legacy.rkt"
-         "contract/private/ds.rkt")
+         "contract/private/ds.rkt"
+         "contract/private/generate.rkt")
 (provide (all-from-out "contract/base.rkt"
                        "contract/combinator.rkt"
                        "contract/parametric.rkt"
                        "contract/region.rkt"
                        "contract/private/legacy.rkt"
-                       "contract/private/ds.rkt"))
+                       "contract/private/ds.rkt"
+                       "contract/private/generate.rkt"))
diff --git a/collects/racket/contract/base.rkt b/collects/racket/contract/base.rkt
index b30d48741c..17bdd1e965 100644
--- a/collects/racket/contract/base.rkt
+++ b/collects/racket/contract/base.rkt
@@ -20,8 +20,7 @@
              procedure-accepts-and-more?
              check-procedure
              check-procedure/more
-             make-contracted-function
-             
+
              contracted-function?
              contracted-function-proc
              contracted-function-ctc
diff --git a/collects/racket/contract/private/arrow.rkt b/collects/racket/contract/private/arrow.rkt
index 47ff1af24f..ab29c455f2 100644
--- a/collects/racket/contract/private/arrow.rkt
+++ b/collects/racket/contract/private/arrow.rkt
@@ -18,10 +18,12 @@ v4 todo:
 
 |#
 
+
 (require "guts.rkt"
          "blame.rkt"
          "prop.rkt"
          "misc.rkt"
+         "generate.rkt"
          racket/stxparam)
 (require (for-syntax racket/base)
          (for-syntax "helpers.rkt")
@@ -30,9 +32,12 @@ v4 todo:
          (for-syntax "arr-util.rkt"))
 
 (provide ->
+         base->?
          ->*
          ->d
          case->
+         base->-rngs/c
+         base->-doms/c
          unconstrained-domain->
          the-unsupplied-arg
          (rename-out [-predicate/c predicate/c])
@@ -520,13 +525,54 @@ v4 todo:
        (= (length (base->-rngs/c that)) (length (base->-rngs/c this)))
        (andmap contract-stronger? (base->-rngs/c this) (base->-rngs/c that))))
 
+(define (->-generate ctc)
+  (let ([doms-l (length (base->-doms/c ctc))])
+    (λ (fuel)
+       (let ([rngs-gens (map (λ (c) (generate/choose c (/ fuel 2)))
+                             (base->-rngs/c ctc))])
+         (if (member #t (map generate-ctc-fail? rngs-gens))
+           (make-generate-ctc-fail)
+           (procedure-reduce-arity
+             (λ args
+                ; Make sure that the args match the contract
+                (begin (unless ((contract-struct-exercise ctc) args (/ fuel 2))
+                           (error "Arg(s) ~a do(es) not match contract ~a\n" ctc))
+                       ; Stash the valid value
+                       ;(env-stash (generate-env) ctc args)
+                       (apply values rngs-gens)))
+             doms-l))))))
+
+(define (->-exercise ctc) 
+  (λ (args fuel)
+     (let* ([new-fuel (/ fuel 2)]
+            [gen-if-fun (λ (c v)
+                           ; If v is a function we need to gen the domain and call
+                           (if (procedure? v)
+                             (let ([newargs (map (λ (c) (contract-generate c new-fuel))
+                                                 (base->-doms/c c))])
+                               (let* ([result (call-with-values 
+                                                (λ () (apply v newargs))
+                                                list)]
+                                      [rngs (base->-rngs/c c)])
+                                 (andmap (λ (c v) 
+                                            ((contract-struct-exercise c) v new-fuel))
+                                         rngs 
+                                         result)))
+                             ; Delegate to check-ctc-val
+                             ((contract-struct-exercise c) v new-fuel)))])
+       (andmap gen-if-fun (base->-doms/c ctc) args))))
+
+
+
 (define-struct (chaperone-> base->) ()
   #:property prop:chaperone-contract
   (build-chaperone-contract-property
    #:projection (->-proj chaperone-procedure)
    #:name ->-name
    #:first-order ->-first-order
-   #:stronger ->-stronger?))
+   #:stronger ->-stronger?
+   #:generate ->-generate
+   #:exercise ->-exercise))
 
 (define-struct (impersonator-> base->) ()
   #:property prop:contract
@@ -534,7 +580,9 @@ v4 todo:
    #:projection (->-proj impersonate-procedure)
    #:name ->-name
    #:first-order ->-first-order
-   #:stronger ->-stronger?))
+   #:stronger ->-stronger?
+   #:generate ->-generate
+   #:exercise ->-exercise))
 
 (define (build--> name
                   pre post
@@ -659,9 +707,9 @@ v4 todo:
                         #f))]))))]))
 
 (define-for-syntax (maybe-a-method/name stx)
-   (if (syntax-parameter-value #'making-a-method)
-       (syntax-property stx 'method-arity-error #t)
-       stx))
+  (if (syntax-parameter-value #'making-a-method)
+      (syntax-property stx 'method-arity-error #t)
+      stx))
 
 ;; ->/proc/main : syntax -> (values syntax[contract-record] syntax[args/lambda-body] syntax[names])
 (define-for-syntax (->/proc/main stx)
diff --git a/collects/racket/contract/private/env.rkt b/collects/racket/contract/private/env.rkt
new file mode 100644
index 0000000000..df4ee4bc25
--- /dev/null
+++ b/collects/racket/contract/private/env.rkt
@@ -0,0 +1,26 @@
+#lang racket/base
+
+(require "arrow.rkt"
+         "guts.rkt")
+(provide
+ build-env)
+
+(define (make-env)
+  (list))
+
+(define (extend-env ctc exp env)
+  (cons (list ctc exp)
+        env))
+
+(define (build-env f-l)
+  (let ([value-contract (dynamic-require 'racket/contract 'value-contract)]
+        ;        [->-rngs/c (dynamic-require 'racket/contract/private/arrow '->-rngs/c)]
+        ;        [contract-stronger? (dynamic-require 'racket/contract 'contract-stronger?)]
+        [env-item (dynamic-require 'racket/contract/private/generator-base 'env-item)]
+        ;        [->-rngs/c (dynamic-require 'racket/contract/private/arrow '->-rngs/c)]
+        )
+    (map (λ (f) 
+           (env-item (value-contract f)
+                     f))
+         f-l))
+  )
diff --git a/collects/racket/contract/private/generate-base.rkt b/collects/racket/contract/private/generate-base.rkt
new file mode 100644
index 0000000000..f534f8ea5d
--- /dev/null
+++ b/collects/racket/contract/private/generate-base.rkt
@@ -0,0 +1,82 @@
+#lang racket/base
+
+(provide
+  make-generate-ctc-fail
+  generate-ctc-fail?
+  find-generate
+  add-generate
+
+  print-freq
+  get-freq
+  merge-freq
+  count-missing-generate
+
+  get-arg-names-space
+  gen-arg-names
+  env-item
+  env-item-name
+  env-item-ctc)
+
+ 
+;; generate 
+(define-struct env-item (ctc name))
+
+;; generate failure type
+(define-struct generate-ctc-fail ())
+
+;; hash tables
+(define freq-hash (make-hash))
+(define gen-hash (make-hash))
+
+;; thread-cell
+(define arg-names-count (make-thread-cell 0))
+
+;; given a predicate returns a generate for this predicate or generate-ctc-fail
+(define (find-generate func [name "internal"])
+  (hash-ref gen-hash func (make-generate-ctc-fail)))
+
+(define (add-generate ctc gen)
+  (hash-set! gen-hash ctc gen))
+  
+
+(define (get-arg-names-space space-needed)
+  (let ([rv (thread-cell-ref arg-names-count)])
+    (thread-cell-set! arg-names-count (+ rv space-needed))
+    rv))
+
+(define (gen-arg-names st-num size)
+  (cond
+    [(<= size 0) (list)]
+    [else (cons (string->symbol (string-append "x-" (number->string st-num)))
+                (gen-arg-names (+ st-num 1) (- size 1)))]))
+
+(define (print-freq)
+  (let* ([l (hash-map freq-hash (λ (k v)
+                                 (list k v)))]
+         [l-s (sort l (λ (e1 e2)
+                        (> (list-ref e1 1)
+                           (list-ref e2 1))))])
+    (map (λ (x)
+           (printf "# ~a : ~a\n" 
+                   (list-ref x 1)
+                   (list-ref x 0)))
+         l-s))
+  null)
+
+(define (count-missing-generate ctc)
+  (hash-update! freq-hash 
+               ctc 
+               (λ (x)
+                 (+ x 1))
+               0))
+
+    
+
+(define (get-freq)
+  freq-hash)
+
+(define (merge-freq h)
+  (hash-for-each h (λ (k v)
+                     (hash-set! freq-hash k (+ (hash-ref freq-hash k 0)
+                                               v)))))
+
diff --git a/collects/racket/contract/private/generate.rkt b/collects/racket/contract/private/generate.rkt
new file mode 100644
index 0000000000..a55384ca96
--- /dev/null
+++ b/collects/racket/contract/private/generate.rkt
@@ -0,0 +1,164 @@
+#lang racket/base
+
+(require "rand.rkt"
+         "generate-base.rkt"
+         "guts.rkt"
+         "prop.rkt"
+         racket/list)
+
+(provide generate-env
+         env-stash
+
+         contract-generate
+
+         generate/direct
+         generate/choose
+
+         make-generate-ctc-fail
+         generate-ctc-fail?)
+
+; env parameter
+(define generate-env (make-parameter #f))
+
+; Adds a new contract and value to the environment if
+; they don't already exist
+(define (env-stash env ctc val)
+  (let* ([curvals (hash-ref env ctc (list))])
+    (hash-set! env ctc (cons val curvals))))
+
+;; hash tables
+;(define freq-hash (make-hash))
+;(define gen-hash (make-hash))
+
+;; thread-cell
+;(define arg-names-count (make-thread-cell 0))
+
+;; generate integer? 
+(add-generate integer?
+           (λ (fuel)
+             (rand-choice
+              [1/10 0]
+              [1/10 1]
+              [1/10 -1]
+              [1/10 2147483647]
+              [1/10 -2147483648]
+              [3/10 (rand-range -100 200)]
+              [else (rand-range -1000000000 2000000000)])))
+
+(add-generate exact-nonnegative-integer?
+               (λ (fuel)
+                 (abs ((find-generate integer?) fuel))))
+
+
+(add-generate positive?
+           (λ (fuel)
+             (rand-choice
+              [1/10 1]
+              [1/10 1/3]
+              [1/10 0.12]
+              [1/10 2147483647]
+              [else 4])))
+
+(add-generate boolean?
+    (λ (fuel)
+       (rand-choice
+         [1/2 #t]
+         [else #f])))
+
+(add-generate char?
+  (λ (fuel)
+     (let* ([gen (oneof (list (rand-range 0 55295)
+                              (rand-range 57344 1114111)))])
+       (integer->char gen))))
+
+(add-generate string?
+  (λ (fuel)
+     (let* ([len (rand-choice [1/10 0]
+                              [1/10 1]
+                              [else (rand-range 2 260)])]
+            [strl (build-list len
+                              (λ (x)
+                                 (gen-pred/direct char? fuel)))])
+       (apply string strl))))
+
+(add-generate byte?
+  (λ (fuel)
+     (rand 256)))
+
+(add-generate bytes?
+  (λ (fuel)
+     (let* ([len (rand-choice
+                   [1/10 0]
+                   [1/10 1]
+                   [else (+ 2 (rand 260))])]
+            [bstr (build-list len
+                              (λ (x)
+                                 (rand 256)))])
+       (apply bytes bstr))))
+
+(define (gen-pred/direct pred fuel)
+  (let ([ctc (coerce-contract 'contract-direct-gen pred)])
+    (generate/direct ctc fuel)))
+
+; generate : contract int -> ctc value or error
+(define (contract-generate ctc fuel)
+ (let ([def-ctc (coerce-contract 'contract-generate ctc)])
+   (parameterize ([generate-env (make-hash)])
+     ; choose randomly
+     (let ([val (generate/choose def-ctc fuel)])
+       (if (generate-ctc-fail? val)
+         (error 'contract-generate
+                "Unable to construct any generator for contract: ~e"
+                ctc)
+         val)))))
+
+; Iterates through generation methods until failure. Returns
+; generate-ctc-fail if no value could be generated
+(define (generate/choose ctc fuel)
+ (let ([options (permute (list generate/direct
+                               generate/direct-env
+                               ))])
+   ; choose randomly
+   (let trygen ([options options])
+     (if (empty? options)
+       (make-generate-ctc-fail)
+       (let* ([option (car options)]
+              [val (option ctc fuel)])
+         (if (generate-ctc-fail? val)
+           (trygen (cdr options))
+                  val))))))
+
+; generate/direct :: contract int -> value for contract
+; Attempts to make a generator that generates values for this contract
+; directly. Returns generate-ctc-fail if making a generator fails.
+(define (generate/direct ctc fuel)
+  (let ([g (contract-struct-generate ctc)])
+    ; Check if the contract has a direct generate attached
+    (if (generate-ctc-fail? g)
+      ; Everything failed -- we can't directly generate this ctc
+      g 
+      (g fuel))))
+
+; generate/direct-env :: contract int -> value
+; Attemps to find a value with the given contract in the environment.
+; Returns it if found and generate-ctc-fail otherwise.
+(define (generate/direct-env ctc fuel)
+  ; TODO: find out how to make negative test cases
+  (let* ([keys (hash-keys (generate-env))]
+         [valid-ctcs (filter (λ (c)
+                                (contract-stronger? c ctc))
+                             keys)])
+    (if (> (length valid-ctcs) 0)
+      (oneof (oneof (map (λ (key)
+                            (hash-ref (generate-env) key))
+                         valid-ctcs)))
+      (make-generate-ctc-fail))))
+
+; generate/indirect-env :: contract int -> (int -> value for contract)
+; Attempts to make a generator that generates values for this contract
+; by calling functions in the environment
+(define (generate/indirect-env ctc fuel)
+  (if (> fuel 0)
+    (make-generate-ctc-fail)
+    (make-generate-ctc-fail)))
+
diff --git a/collects/racket/contract/private/guts.rkt b/collects/racket/contract/private/guts.rkt
index 39e6178986..cbb9895abc 100644
--- a/collects/racket/contract/private/guts.rkt
+++ b/collects/racket/contract/private/guts.rkt
@@ -1,6 +1,11 @@
 #lang racket/base
 
-(require "prop.rkt")
+(require "helpers.rkt"
+         "blame.rkt"
+         "prop.rkt"
+         "rand.rkt"
+         "generate-base.rkt"
+         racket/pretty)
 
 (require (for-syntax racket/base))
 
@@ -148,7 +153,7 @@
   (cond
     [(contract-struct? x) x]
     [(and (procedure? x) (procedure-arity-includes? x 1)) 
-     (make-predicate-contract (or (object-name x) '???) x)]
+     (make-predicate-contract (or (object-name x) '???) x (make-generate-ctc-fail))]
     [(or (symbol? x) (boolean? x) (char? x) (null? x)) (make-eq-contract x)]
     [(or (bytes? x) (string? x)) (make-equal-contract x)]
     [(number? x) (make-=-contract x)]
@@ -237,10 +242,6 @@
     (if (contract-struct? sub) (contract-struct-name sub) sub)))
 
 
-
-
-
-
 ;                                                                                                                 
 ;                                                                                                                 
 ;                                                                                                                 
@@ -308,7 +309,7 @@
       (and (regexp/c? that) (eq? (regexp/c-reg this) (regexp/c-reg that))))))
 
 
-(define-struct predicate-contract (name pred)
+(define-struct predicate-contract (name pred generate)
   #:property prop:flat-contract
   (build-flat-contract-property
    #:stronger
@@ -317,7 +318,18 @@
            (procedure-closure-contents-eq? (predicate-contract-pred this)
                                            (predicate-contract-pred that))))
    #:name (λ (ctc) (predicate-contract-name ctc))
-   #:first-order (λ (ctc) (predicate-contract-pred ctc))))
+   #:first-order (λ (ctc) (predicate-contract-pred ctc))
+   #:generate (λ (ctc)
+                 (let ([generate (predicate-contract-generate ctc)])
+                   (if (generate-ctc-fail? generate)
+                     (let ([fn (predicate-contract-pred ctc)])
+                       (find-generate fn (predicate-contract-name ctc)))
+                     generate)))
+   #:exercise (λ (ctc)
+                 (λ (val fuel) 
+                    ((predicate-contract-pred ctc) val)))))
 
 (define (check-flat-named-contract predicate) (coerce-flat-contract 'flat-named-contract predicate))
 (define (check-flat-contract predicate) (coerce-flat-contract 'flat-contract predicate))
+(define (build-flat-contract name pred [generate (make-generate-ctc-fail)])
+  (make-predicate-contract name pred generate))
diff --git a/collects/racket/contract/private/misc.rkt b/collects/racket/contract/private/misc.rkt
index 9d7145c994..d6d283f26d 100644
--- a/collects/racket/contract/private/misc.rkt
+++ b/collects/racket/contract/private/misc.rkt
@@ -4,7 +4,9 @@
          racket/promise
          "prop.rkt"
          "blame.rkt"
-         "guts.rkt")
+         "guts.rkt"
+         "rand.rkt"
+         "generate.rkt")
 
 (provide flat-rec-contract
          flat-murec-contract
@@ -295,7 +297,12 @@
                           that-ctcs)))))
 
    #:first-order
-   (λ (ctc) (flat-or/c-pred ctc))))
+   (λ (ctc) (flat-or/c-pred ctc))
+   #:generate
+   (λ (ctc)
+      (λ (fuel)
+         (generate/direct (oneof (flat-or/c-flat-ctcs ctc)) fuel)))
+         ))
 
 
 (define (and-name ctc)
@@ -482,7 +489,20 @@
             [m (between/c-high ctc)])
         (λ (x) 
            (and (real? x)
-                (<= n x m)))))))
+                (<= n x m)))))
+   #:generate
+   (λ (ctc)
+      (λ (fuel)
+         (let* ([max-n 2147483647]
+                [min-n -2147483648]
+                [upper (if (> (between/c-high ctc) max-n)
+                         max-n
+                         (between/c-high ctc))]
+                [lower (if (< (between/c-low ctc) min-n)
+                         min-n
+                         (between/c-low ctc))])
+           (+ (random (- upper lower))
+              lower))))))
 
 (define-syntax (check-unary-between/c stx)
   (syntax-case stx ()
@@ -514,11 +534,28 @@
 (define (</c x)
   (flat-named-contract
    `(</c ,x)
-   (λ (y) (and (real? y) (< y x)))))
+   (λ (y) (and (real? y) (< y x)))
+   (λ (fuel)
+      (let* ([max-n 2147483647]
+             [min-n -2147483648]
+             [upper (if (> x max-n)
+                      max-n
+                      x)])
+        (+ (random (- upper min-n))
+           min-n)))))
+
 (define (>/c x)
   (flat-named-contract
-   `(>/c ,x)
-   (λ (y) (and (real? y) (> y x)))))
+    `(>/c ,x)
+    (λ (y) (and (real? y) (> y x)))
+    (λ (fuel) 
+       (let* ([max-n 2147483647]
+              [min-n -2147483648]
+              [lower (if (< x min-n)
+                       min-n
+                       x)])
+         (+ (random (- max-n lower))
+            lower)))))
 
 (define/final-prop (integer-in start end)
   (unless (and (integer? start)
@@ -546,6 +583,19 @@
      (build-compound-type-name 'not/c ctc)
      (λ (x) (not (pred x))))))
 
+(define (listof-generate elem-ctc)
+  (λ (fuel)
+     (define (mk-rand-list so-far)
+       (rand-choice
+         [1/5 so-far]
+         [else (mk-rand-list (cons (generate/direct elem-ctc fuel)
+                                   so-far))]))
+     (mk-rand-list (list))))
+
+(define (listof-exercise el-ctc)
+  (λ (f n-tests size env)
+    #t))
+
 (define-syntax (*-listof stx)
   (syntax-case stx ()
     [(_ predicate? type-name name)
@@ -572,25 +622,118 @@
              (make-flat-contract
               #:name ctc-name
               #:first-order fo-check
-              #:projection (ho-check (λ (p v) (for-each p v) v)))]
+              #:projection (ho-check (λ (p v) (for-each p v) v))
+              #:generate (listof-generate ctc))]
             [(chaperone-contract? ctc)
              (make-chaperone-contract
               #:name ctc-name
               #:first-order fo-check
-              #:projection (ho-check (λ (p v) (map p v))))]
+              #:projection (ho-check (λ (p v) (map p v)))
+              #:generate (listof-generate ctc))]
             [else
              (make-contract
               #:name ctc-name
               #:first-order fo-check
-              #:projection (ho-check (λ (p v) (map p v))))]))))]))
+              #:projection (ho-check (λ (p v) (map p v)))
+              )]))))]))
 
 (define listof-func (*-listof list? list listof))
 (define/subexpression-pos-prop (listof x) (listof-func x))
 
-(define (non-empty-list? x) (and (pair? x) (list? (cdr x))))
+#|
+(define (listof element-ctc)
+  ;  (printf "bla")
+  (if (flat-contract? element-ctc)
+      (begin 
+        ;        (printf "flat\n")
+        (make-listof-flat/c element-ctc))
+      (begin 
+        ;        (printf "non-flat\n")
+        (make-listof/c element-ctc))))
+|#
+
+;(*-immutableof list? map andmap list listof))
+
+(define-struct listof-flat/c (element-ctc)
+  #:omit-define-syntaxes
+  #:property prop:flat-contract
+  (build-flat-contract-property
+   #:name 
+   (λ (ctc)
+     (build-compound-type-name 'listof (object-name (listof-flat/c-element-ctc ctc))))
+   #|
+    #:projection
+    (λ (ctc)
+      ;     (let* ([content-pred? (listof-flat/c-element-ctc ctc)])
+      (let* ([content-ctc (listof-flat/c-element-ctc ctc)]
+             [content-pred? (flat-contract-predicate ctc)])
+        (λ (blame)
+          (λ (x)
+            (unless (and (list? x) (andmap content-pred? x))
+              (raise-blame-error
+                 blame
+                 x
+                 "expected <~a>, given: ~e"
+                 'type-name
+                 x))
+            #t))))
+ |#
+   #:first-order
+   (λ (ctc)
+     (let ([content-pred? (listof-flat/c-element-ctc ctc)])
+       (λ (val)
+         (and (list? val) (andmap content-pred? val)))))
+   #:generate
+   (λ (ctc)
+     ;     #f)
+     (listof-generate (listof-flat/c-element-ctc ctc)))
+   #:exercise
+   (λ (ctc)
+     ;     #f)))
+     (listof-exercise (listof-flat/c-element-ctc ctc)))))
+
+
+
+
+(define-struct listof/c (element-ctc)
+  #:omit-define-syntaxes
+  #:property prop:contract
+  (build-contract-property
+   #:name 
+   (λ (ctc)
+     (build-compound-type-name 'listof (object-name (listof/c-element-ctc ctc))))
+   #:projection
+   (λ (ctc)
+     (let* ([el-ctc (listof/c-element-ctc ctc)]
+            [proj (contract-projection el-ctc)])
+       (λ (blame)
+         (let ([p-app (proj blame)])
+           (λ (val)
+             (unless (list? val)
+               (raise-blame-error
+                blame
+                val
+                "expected <~a>, given: ~e"
+                'type-name
+                val))
+             (map p-app val))))))
+   #:first-order
+   (λ (ctc)
+     list?)
+   #:generate
+   (λ (ctc)
+     ;     #f)
+     (listof-generate (listof/c-element-ctc ctc)))
+   #:exercise
+   (λ (ctc)
+     ;     #f)))
+     (listof-exercise (listof/c-element-ctc ctc)))))
+
+(define (non-empty-list? x) (and (pair? x) (list (cdr x))))
 (define non-empty-listof-func (*-listof non-empty-list? non-empty-list non-empty-listof))
 (define/subexpression-pos-prop (non-empty-listof a) (non-empty-listof-func a))
 
+
 (define cons/c-main-function
   (λ (car-c cdr-c)
     (let* ([ctc-car (coerce-contract 'cons/c car-c)]
@@ -851,13 +994,13 @@
    (coerce-contract 'contract-projection ctc)))
 
 (define (flat-contract predicate) (coerce-flat-contract 'flat-contract predicate))
-(define (flat-named-contract name predicate)
+(define (flat-named-contract name predicate [generate (make-generate-ctc-fail)])
   (cond
     [(and (procedure? predicate)
           (procedure-arity-includes? predicate 1))
-     (make-predicate-contract name predicate)]
+     (make-predicate-contract name predicate generate)]
     [(flat-contract? predicate)
-     (make-predicate-contract name (flat-contract-predicate predicate))]
+     (make-predicate-contract name (flat-contract-predicate predicate) generate)]
     [else
      (error 'flat-named-contract 
             "expected a flat contract or procedure of arity 1 as second argument, got ~e" 
diff --git a/collects/racket/contract/private/prop.rkt b/collects/racket/contract/private/prop.rkt
index f19f052936..f2fe2fa5b0 100644
--- a/collects/racket/contract/private/prop.rkt
+++ b/collects/racket/contract/private/prop.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require "blame.rkt")
+(require "blame.rkt"
+         "generate-base.rkt")
 
 (provide prop:contract
          contract-struct?
@@ -8,6 +9,8 @@
          contract-struct-first-order
          contract-struct-projection
          contract-struct-stronger?
+         contract-struct-generate
+         contract-struct-exercise
 
          prop:flat-contract
          flat-contract-struct?
@@ -34,7 +37,7 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-struct contract-property [ name first-order projection stronger generator ]
+(define-struct contract-property [ name first-order projection stronger generate exercise ]
   #:omit-define-syntaxes)
 
 (define (contract-property-guard prop info)
@@ -73,6 +76,23 @@
          [stronger (contract-property-stronger prop)])
     (stronger a b)))
 
+(define (contract-struct-generate c)
+  (let* ([prop (contract-struct-property c)]
+         [generate (contract-property-generate prop)])
+    (if (procedure? generate)
+      ; FIXME: Call needs to take multiple arguments
+        (generate c)
+        (begin
+          (count-missing-generate (contract-struct-name c))
+          (make-generate-ctc-fail)))))
+
+(define (contract-struct-exercise c)
+  (let* ([prop (contract-struct-property c)]
+         [exercise (contract-property-exercise prop)])
+    (if (procedure? exercise)
+        (exercise c)
+        (make-generate-ctc-fail))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  Chaperone Contract Property
@@ -154,7 +174,8 @@
          #:first-order [get-first-order #f]
          #:projection [get-projection #f]
          #:stronger [stronger #f]
-         #:generator [generator #f])
+         #:generate [generate (make-generate-ctc-fail)]
+         #:exercise [exercise (make-generate-ctc-fail)])
 
   (let* ([get-name (or get-name (lambda (c) default-name))]
          [get-first-order (or get-first-order get-any?)]
@@ -165,7 +186,7 @@
                    get-name get-first-order)])]
          [stronger (or stronger weakest)])
 
-    (mk get-name get-first-order get-projection stronger generator)))
+    (mk get-name get-first-order get-projection stronger generate exercise )))
 
 (define build-contract-property
   (build-property make-contract-property 'anonymous-contract values))
@@ -219,7 +240,7 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-struct make-contract [ name first-order projection stronger ]
+(define-struct make-contract [ name first-order projection stronger generate exercise ]
   #:omit-define-syntaxes
   #:property prop:contract
   (build-contract-property
@@ -227,9 +248,10 @@
    #:first-order (lambda (c) (make-contract-first-order c))
    #:projection (lambda (c) (make-contract-projection c))
    #:stronger (lambda (a b) ((make-contract-stronger a) a b))
-   #:generator #f))
+   #:generate (lambda (c) ((make-contract-generate c)))
+   #:exercise (lambda (c) ((make-contract-exercise c)))))
 
-(define-struct make-chaperone-contract [ name first-order projection stronger ]
+(define-struct make-chaperone-contract [ name first-order projection stronger generate exercise ]
   #:omit-define-syntaxes
   #:property prop:chaperone-contract
   (build-chaperone-contract-property
@@ -237,9 +259,10 @@
    #:first-order (lambda (c) (make-chaperone-contract-first-order c))
    #:projection (lambda (c) (make-chaperone-contract-projection c))
    #:stronger (lambda (a b) ((make-chaperone-contract-stronger a) a b))
-   #:generator #f))
+   #:generate (lambda (c) (make-chaperone-contract-generate c))
+   #:exercise (lambda (c) (make-chaperone-contract-exercise c))))
 
-(define-struct make-flat-contract [ name first-order projection stronger ]
+(define-struct make-flat-contract [ name first-order projection stronger generate exercise ]
   #:omit-define-syntaxes
   #:property prop:flat-contract
   (build-flat-contract-property
@@ -247,20 +270,23 @@
    #:first-order (lambda (c) (make-flat-contract-first-order c))
    #:projection (lambda (c) (make-flat-contract-projection c))
    #:stronger (lambda (a b) ((make-flat-contract-stronger a) a b))
-   #:generator #f))
+   #:generate (lambda (c) (make-flat-contract-generate c))
+   #:exercise (lambda (c) (make-chaperone-contract-exercise c))))
 
 (define ((build-contract mk default-name)
          #:name [name #f]
          #:first-order [first-order #f]
          #:projection [projection #f]
-         #:stronger [stronger #f])
+         #:stronger [stronger #f]
+         #:generate [generate (make-generate-ctc-fail)]
+         #:exercise [exercise (make-generate-ctc-fail)] )
 
   (let* ([name (or name default-name)]
          [first-order (or first-order any?)]
          [projection (or projection (first-order-projection name first-order))]
          [stronger (or stronger as-strong?)])
 
-    (mk name first-order projection stronger)))
+    (mk name first-order projection stronger generate exercise)))
 
 (define (as-strong? a b)
   (procedure-closure-contents-eq?
@@ -275,3 +301,4 @@
 
 (define make-flat-contract
   (build-contract make-make-flat-contract 'anonymous-flat-contract))
+
diff --git a/collects/racket/contract/private/rand.rkt b/collects/racket/contract/private/rand.rkt
new file mode 100644
index 0000000000..20046ceace
--- /dev/null
+++ b/collects/racket/contract/private/rand.rkt
@@ -0,0 +1,89 @@
+#lang racket/base
+
+(require (for-syntax scheme/base))
+
+(provide rand
+         rand-seed
+         rand-choice
+         rand-range
+         permute
+         oneof)
+
+
+;; random generator
+
+(define my-generator (make-pseudo-random-generator))
+(define (rand [x #f]) 
+  (if x
+      (random x my-generator)
+      (random my-generator)))
+
+
+(define (rand-seed x)
+  (parameterize ([current-pseudo-random-generator my-generator])
+    (random-seed x)))
+
+(rand-seed 0)
+
+(define-syntax (rand-choice stx)
+  (syntax-case stx ()
+    [(_ (a case1 case2 ...) ...)
+     (begin
+       (let ([ns (let loop ([sum 0]
+                            [as (syntax->list #'(a ...))])
+                   (cond
+                     [(null? as) (raise-syntax-error #f "expected at least one case" stx)]
+                     [(null? (cdr as))
+                      (syntax-case (car as) (else)
+                        [else (list (- 1 sum))]
+                        [_ (raise-syntax-error #f "expected last option to be `else'" stx (car as))])]
+                     [else
+                      (let ([n (syntax-e (car as))])
+                        (unless (and (real? n)
+                                     (exact? n)
+                                     (positive? n)
+                                     (< n 1))
+                          (raise-syntax-error #f "expected each option to be a real exact number in the interval (0,1)" stx (car as)))
+                        (unless (< (+ n sum) 1)
+                          (raise-syntax-error #f "expected the sum of the options to be less than 1" stx #f (syntax->list #'(a ...))))
+                        (cons n (loop (+ sum n)
+                                      (cdr as))))]))])
+         (let* ([dens (map denominator ns)]
+                [choices (map (λ (x) (* (numerator x) (apply * (remove
+                                                                (denominator x) dens))))
+                              ns)])
+           #`(rand-choice/proc '(#,@choices)
+                               #,(apply * dens)
+                               (list (λ () case1 case2 ...) ...)))))]))
+
+(define (rand-choice/proc choices prod thunks)
+  (let ([choice (rand prod)])
+    (let loop ([n choice]
+               [nums choices]
+               [thunks thunks])
+      (cond
+        [(null? nums) (error 'rand-chance "internal error!")]
+        [else
+         (cond
+           [(< n (car nums))
+            ((car thunks))]
+           [else
+            (loop (- n (car nums))
+                  (cdr nums)
+                  (cdr thunks))])]))))
+
+; oneof :: [a] -> a
+; Randomly chooses one of the values from a given list
+(define (oneof a-list) 
+  (list-ref a-list (random (length a-list))))
+
+; fisher-yates shuffle
+(define (permute a-list)
+  (do ((v (list->vector a-list)) (n (length a-list) (- n 1)))
+      ((zero? n) (vector->list v))
+    (let* ((r (random n)) (t (vector-ref v r)))
+      (vector-set! v r (vector-ref v (- n 1)))
+      (vector-set! v (- n 1) t))))
+
+(define (rand-range lower upper)
+  (+ lower (rand (- upper lower))))
diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl
index e4e827c394..9f62fc00e8 100644
--- a/collects/scribblings/reference/contracts.scrbl
+++ b/collects/scribblings/reference/contracts.scrbl
@@ -6,7 +6,7 @@
 @(define contract-eval
    (lambda ()
      (let ([the-eval (make-base-eval)])
-       (the-eval '(require racket/contract))
+       (the-eval '(require racket/contract racket/contract/parametric))
        the-eval)))
 
 @title[#:tag "contracts" #:style 'toc]{Contracts}
@@ -84,10 +84,14 @@ Constructs a @tech{flat contract} from @racket[predicate]. A value
 satisfies the contract if the predicate returns a true value.}
 
 
-@defproc[(flat-named-contract [type-name any/c] 
-                              [predicate (or/c flat-contract? (any/c . -> . any))])
+@defproc[(flat-named-contract [type-name any/c]
+                              [predicate (or/c flat-contract? (any/c . -> . any))]
+                              [#:generate generator (-> contract (-> int? 'a-val))])
          flat-contract?]{
 
+The generator argument adds a generator for the flat-named-contract. See 
+@racket[contract-generate] for more information.
+
 On predicates like @racket[flat-contract], but the first argument must be the
 (quoted) name of a contract used for error reporting. 
 For example, 
@@ -2083,3 +2087,11 @@ parts of the contract system.
   struct and returns a projection function that checks the contract.
   
 }
+@section{Random generation}
+
+@defproc[(contract-generate [ctc contract?] [fuel int?]) any/c]{
+Attempts to randomly generate a value which will match the contract. The fuel
+argument limits the depth that the argument generation can go and thus the
+memory used. In order to know which contracts to generate, it may be necessary
+to add a generator for the generate keyword argument in @racket[struct]
+}
diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl
index f62974ff82..9f4fb816d7 100644
--- a/collects/scribblings/reference/struct.scrbl
+++ b/collects/scribblings/reference/struct.scrbl
@@ -100,7 +100,9 @@ override the default @racket[equal?] definition through the
                            [immutables (listof exact-nonnegative-integer?)
                                        null]
                            [guard (or/c procedure? #f) #f]
-                           [constructor-name (or/c symbol? #f) #f])
+                           [constructor-name (or/c symbol? #f) #f]
+                           [generate (-> contract? (-> int? any/c))]
+                           [exercise (-> contract? (-> int? any/c any/c))])
           (values struct-type?
                   struct-constructor-procedure?
                   struct-predicate-procedure?
@@ -174,6 +176,14 @@ If @racket[constructor-name] is not @racket[#f], it is used as the
 name of the generated @tech{constructor} procedure as returned by
 @racket[object-name] or in the printed form of the constructor value.
 
+The @racket[generate] argument is used to define a new generator for
+this structure type, which can be used to create random instances of
+the structure type. For more information see @racket[contract-generate].
+
+The @racket[exercise] argument allows you to define a function to verify
+that a given value is an instance of your contract. This will also be used
+for random generation.
+
 The result of @racket[make-struct-type] is five values:
 
 @itemize[
diff --git a/collects/tests/racket/contract-rand-test.rkt b/collects/tests/racket/contract-rand-test.rkt
new file mode 100644
index 0000000000..17bf73dea9
--- /dev/null
+++ b/collects/tests/racket/contract-rand-test.rkt
@@ -0,0 +1,68 @@
+#lang racket/base
+
+(require racket/contract
+         rackunit
+         rackunit/text-ui
+         net/url)
+
+(define (test-contract-generation ctc 
+                                  [monkey-with values] 
+                                  #:size [size 10])
+  ;; generator : number[of tests] number[size bound] ??[env] -> any
+  (define example-vals (contract-generate ctc size))
+  (monkey-with (contract ctc example-vals 'pos 'neg)))
+
+(define pred-tests
+  (test-suite
+   "Predicate contract"
+   (check-not-exn (λ () (test-contract-generation integer?)))
+   (check-not-exn (λ () (test-contract-generation exact-nonnegative-integer?)))
+   (check-not-exn (λ () (test-contract-generation boolean?)))
+   (check-not-exn (λ () (test-contract-generation char?)))
+   (check-not-exn (λ () (test-contract-generation byte?)))
+   (check-not-exn (λ () (test-contract-generation bytes?)))
+   (check-not-exn (λ () (test-contract-generation string?)))
+  ))
+
+(define flat-ctc-tests
+  (test-suite
+    "Built-in flat contracts"
+    (check-not-exn (λ () (test-contract-generation (between/c 1 100))))
+    (check-not-exn (λ () (test-contract-generation (listof integer?))))
+    (check-not-exn (λ () (test-contract-generation (>=/c 0))))
+    (check-not-exn (λ () (test-contract-generation (<=/c 0))))
+    (check-not-exn (λ () (test-contract-generation (>/c 0))))
+    (check-not-exn (λ () (test-contract-generation (</c 0))))
+    (check-not-exn (λ () (test-contract-generation (or/c boolean? boolean?))))
+    ))
+
+(define func-tests
+  (test-suite
+    "Function contracts"
+    (check-exn exn:fail? (λ ()
+                            ((test-contract-generation (-> char?
+                                                           integer?)) 0)))
+    (check-not-exn (λ () ((test-contract-generation (-> integer?
+                                                        integer?)) 1)))
+    (check-not-exn (λ () ((test-contract-generation 
+                             (-> (-> integer? 
+                                     integer?)
+                                 boolean?)) 
+                            +)))
+    ;(check-not-exn (λ () (test-contract-generation (-> (or/c bytes string?)
+    ;                                                   url?)
+    ;                                               "test")))
+    ))
+
+;(define net/url-tests
+;  (test-suite "net/url contracts"
+
+(define ctc-gen-tests
+  (test-suite
+    "All random contract generation tests"
+    pred-tests
+    flat-ctc-tests
+    func-tests))
+
+
+(run-tests ctc-gen-tests)