diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/contracts.scrbl
index 97026c3618..0c12660077 100644
--- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/contracts.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/contracts.scrbl
@@ -373,14 +373,56 @@ reasons of backwards compatibility.}
 
 Returns a contract that recognizes a list whose every element matches
 the contract @racket[c]. Beware that when this contract is applied to
-a value, the result is not necessarily @racket[eq?] to the input.}
+a value, the result is not necessarily @racket[eq?] to the input.
+
+@examples[#:eval (contract-eval)
+                 (define/contract some-numbers
+                   (listof number?)
+                   (list 1 2 3))
+                 (define/contract just-one-number
+                   (listof number?)
+                   11)]
+
+}
 
 
 @defproc[(non-empty-listof [c contract?]) list-contract?]{
 
 Returns a contract that recognizes non-empty lists whose elements match
 the contract @racket[c]. Beware that when this contract is applied to
-a value, the result is not necessarily @racket[eq?] to the input.}
+a value, the result is not necessarily @racket[eq?] to the input.
+
+@examples[#:eval (contract-eval)
+                 (define/contract some-numbers
+                   (non-empty-listof number?)
+                   (list 1 2 3))
+                                
+                 (define/contract not-enough-numbers
+                   (non-empty-listof number?)
+                   (list))]
+}
+
+@defproc[(list*of [c contract?]) contract?]{
+
+Returns a contract that recognizes improper lists whose elements match
+the contract @racket[c]. If an improper list is created with @racket[cons],
+then its @racket[car] position is expected to match @racket[c] and
+its @racket[cdr] position is expected to be @racket[(list*of c)]. Otherwise,
+it is expected to match @racket[c]. Beware that when this contract is applied to
+a value, the result is not necessarily @racket[eq?] to the input.
+
+@examples[#:eval (contract-eval)
+                 (define/contract improper-numbers
+                   (list*of number?)
+                   (cons 1 (cons 2 3)))
+                                
+                 (define/contract not-improper-numbers
+                   (list*of number?)
+                   (list 1 2 3))]
+
+@history[#:added "6.1.1.1"]
+}
+
 
 @defproc[(cons/c [car-c contract?] [cdr-c contract?]) contract?]{
 
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
index ec6450b880..504d3f4355 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt
@@ -47,6 +47,7 @@
 (check-not-exn (λ () (test-contract-generation (listof boolean?))))
 (check-not-exn (λ () (test-contract-generation (listof some-crazy-predicate?))))
 (check-not-exn (λ () (test-contract-generation (non-empty-listof boolean?))))
+(check-not-exn (λ () (test-contract-generation (list*of boolean?))))
 (check-not-exn (λ () (test-contract-generation (list/c boolean? number?))))
 (check-not-exn (λ () ((car (test-contract-generation (list/c (-> number? number?)))) 0)))
 
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/list-contract.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/list-contract.rkt
index bebaedc2d1..e8e890e573 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/list-contract.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/list-contract.rkt
@@ -52,6 +52,11 @@
    '(list-contract? (listof any/c))
    #t)
   
+  (test/spec-passed/result
+   'list-contract-10b
+   '(list-contract? (list*of any/c))
+   #f)
+  
   (test/spec-passed/result
    'list-contract-11
    '(list-contract? (non-empty-listof any/c))
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/list.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/list.rkt
index 4dd2427077..101ed1db6f 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/list.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/list.rkt
@@ -11,4 +11,56 @@
   (test/no-error '(list/c 'x "x" #t #f #\c #rx"a" #rx#"b"))
   
   (test/pos-blame 'list1 '(contract (list/c 1 2) (list 1 3) 'pos 'neg))
-  (test/no-error '(contract (list/c 1 2) (list 1 2) 'pos 'neg)))
\ No newline at end of file
+  (test/no-error '(contract (list/c 1 2) (list 1 2) 'pos 'neg))
+  
+  (test/spec-passed/result 
+   'listof1
+   '(contract (listof integer?) '(1 2 3) 'pos 'neg)
+   '(1 2 3))
+  (test/spec-passed/result 
+   'listof2
+   '(contract (listof integer?) '() 'pos 'neg)
+   '())
+  (test/pos-blame 
+   'listof3
+   '(contract (listof integer?) #f 'pos 'neg))
+  (test/pos-blame 
+   'listof4
+   '(contract (listof integer?) (cons 1 2) 'pos 'neg))
+  (test/pos-blame 
+   'listof5
+   '(contract (listof integer?) (list #f #t) 'pos 'neg))
+  
+  (test/spec-passed/result 
+   'nelistof1
+   '(contract (non-empty-listof integer?) '(1 2 3) 'pos 'neg)
+   '(1 2 3))
+  (test/pos-blame  
+   'nelistof2
+   '(contract (non-empty-listof integer?) '() 'pos 'neg))
+  (test/pos-blame 
+   'nelistof3
+   '(contract (non-empty-listof integer?) #f 'pos 'neg))
+  (test/pos-blame 
+   'nelistof4
+   '(contract (non-empty-listof integer?) (cons 1 2) 'pos 'neg))
+  (test/pos-blame 
+   'nelistof5
+   '(contract (non-empty-listof integer?) (list #f #t) 'pos 'neg))
+  
+  (test/spec-passed/result 
+   'imlistof1
+   '(contract (list*of integer?) '(1 2 . 3) 'pos 'neg)
+   '(1 2 . 3))
+  (test/pos-blame
+   'imlistof2
+   '(contract (list*of integer?) '() 'pos 'neg))
+  (test/pos-blame 
+   'imlistof3
+   '(contract (list*of integer?) #f 'pos 'neg))
+  (test/pos-blame 
+   'imlistof4
+   '(contract (list*of integer?) (list 1 2) 'pos 'neg))
+  (test/pos-blame 
+   'imlistof5
+   '(contract (list*of integer?) (cons #f #t) 'pos 'neg)))
\ No newline at end of file
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt
index 5687080199..21b0961ae7 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt
@@ -217,17 +217,15 @@
 
   (test-name '(listof boolean?) (listof boolean?))
   (test-name '(listof any/c) (listof any/c))
-  (test-name '(listof boolean?) (listof boolean?))
-  (test-name '(listof any/c) (listof any/c))
-  (test-name '(listof boolean?) (listof boolean?))
   (test-name '(listof (-> boolean? boolean?)) (listof (-> boolean? boolean?)))
 
   (test-name '(non-empty-listof boolean?) (non-empty-listof boolean?))
   (test-name '(non-empty-listof any/c) (non-empty-listof any/c))
-  (test-name '(non-empty-listof boolean?) (non-empty-listof boolean?))
-  (test-name '(non-empty-listof any/c) (non-empty-listof any/c))
-  (test-name '(non-empty-listof boolean?) (non-empty-listof boolean?))
   (test-name '(non-empty-listof (-> boolean? boolean?)) (non-empty-listof (-> boolean? boolean?)))
+  
+  (test-name '(list*of boolean?) (list*of boolean?))
+  (test-name '(list*of any/c) (list*of any/c))
+  (test-name '(list*of (-> boolean? boolean?)) (list*of (-> boolean? boolean?)))
 
 
   (test-name '(vectorof boolean?) (vectorof boolean?))
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/stronger.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/stronger.rkt
index 139c2e400b..e2c163ab9f 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/stronger.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/stronger.rkt
@@ -160,7 +160,9 @@
          (cons/c (<=/c 1) (cons/c (<=/c 2) (listof (<=/c 3)))) 
          (listof (<=/c 4)))
   (ctest #f contract-stronger? (listof number?) (cons/c number? (cons/c number? (listof any/c))))
-    
+  (ctest #t contract-stronger? (list*of (<=/c 2)) (list*of (<=/c 3)))
+  (ctest #f contract-stronger? (list*of (<=/c 3)) (list*of (<=/c 2)))
+  
   (ctest #f contract-stronger? (vectorof (<=/c 3)) (vectorof (<=/c 4)))
   (ctest #f contract-stronger? (vectorof (<=/c 3)) (vectorof (<=/c 4)))
   (ctest #t contract-stronger? (vectorof (<=/c 3) #:immutable #t) (vectorof (<=/c 4) #:immutable #t))
diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt
index 6bc4e672c8..f14bb87c20 100644
--- a/racket/collects/racket/contract/private/misc.rkt
+++ b/racket/collects/racket/contract/private/misc.rkt
@@ -20,7 +20,7 @@
          string-len/c
          false/c
          printable/c
-         listof non-empty-listof cons/c list/c
+         listof list*of non-empty-listof cons/c list/c
          promise/c
          syntax/c
          
@@ -468,9 +468,14 @@
     (define eg (generate/choose (listof-ctc-elem-c ctc) fuel))
     (if eg
         (λ ()
-          (let loop ([so-far (if (pe-listof-ctc? ctc)
-                                 '()
-                                 (list (eg)))])
+          (let loop ([so-far (cond
+                               [(pe-listof-ctc? ctc)
+                                '()]
+                               [(ne-listof-ctc? ctc)
+                                (list (eg))]
+                               [else
+                                ;; improper list
+                                (eg)])])
             (rand-choice
              [1/5 so-far]
              [else (loop (cons (eg) so-far))])))
@@ -488,17 +493,27 @@
        (define env (generate-env))
        (values
         (λ (lst)
-          (env-stash env elem-ctc (oneof lst)))
+          (env-stash env elem-ctc 
+                     (oneof
+                      (if (im-listof-ctc? ctc)
+                          (improper-list->list lst)
+                          lst))))
         (list elem-ctc)))]))
 
+(define (improper-list->list l)
+  (cond
+    [(pair? l) (cons (car l) (improper-list->list (cdr l)))]
+    [else (list l)]))
+
 (define (listof-stronger this that)
   (define this-elem (listof-ctc-elem-c this))
   (cond
     [(listof-ctc? that)
      (define that-elem (listof-ctc-elem-c that))
-     (and (if (pe-listof-ctc? this)
-              (pe-listof-ctc? that)
-              #t)
+     (and (cond
+            [(pe-listof-ctc? this) (pe-listof-ctc? that)]
+            [(im-listof-ctc? this) (im-listof-ctc? that)]
+            [else #t])
           (contract-stronger? this-elem that-elem))]
     [(the-cons/c? that)
      (define hd-ctc (the-cons/c-hd-ctc that))
@@ -520,9 +535,13 @@
 (define (non-empty-list? x) (and (pair? x) (list? x)))
 
 (define (list-name ctc)
-  (build-compound-type-name (if (pe-listof-ctc? ctc)
-                                'listof
-                                'non-empty-listof)
+  (build-compound-type-name (cond
+                              [(pe-listof-ctc? ctc)
+                               'listof]
+                              [(ne-listof-ctc? ctc)
+                               'non-empty-listof]
+                              [(im-listof-ctc? ctc)
+                               'list*of])
                             (listof-ctc-elem-c ctc)))
 
 (define (list-fo-check ctc)
@@ -538,8 +557,17 @@
        (and (list? v)
             (pair? v)
             (for/and ([e (in-list v)])
-              (elem-fo? e))))]))
-     
+              (elem-fo? e))))]
+    [(im-listof-ctc? ctc)
+     (λ (v)
+       (let loop ([v v])
+         (cond
+           [(pair? v) 
+            (and (elem-fo? (car v))
+                 (loop (cdr v)))]
+           [else
+            (elem-fo? v)])))]))
+
 (define (listof-projection ctc)
   (define elem-proj (contract-projection (listof-ctc-elem-c ctc)))
   (define pred? (if (pe-listof-ctc? ctc)
@@ -549,19 +577,37 @@
     (define elem-proj+blame (elem-proj (blame-add-listof-context blame)))
     (cond
       [(flat-listof-ctc? ctc)
-       (λ (val)
-         (if (pred? val)
-             (begin
-               (for ([x (in-list val)])
-                 (elem-proj+blame x))
-               val)
-             (raise-listof-blame-error blame val (pe-listof-ctc? ctc) #f)))]
+       (if (im-listof-ctc? ctc)
+           (λ (val)
+             (let loop ([val val])
+               (cond
+                 [(pair? val)
+                  (elem-proj+blame (car val))
+                  (loop (cdr val))]
+                 [else
+                  (elem-proj+blame val)]))
+             val)
+           (λ (val)
+             (if (pred? val)
+                 (begin
+                   (for ([x (in-list val)])
+                     (elem-proj+blame x))
+                   val)
+                 (raise-listof-blame-error blame val (pe-listof-ctc? ctc) #f))))]
       [else
-       (λ (val)
-         (if (pred? val)
-             (for/list ([x (in-list val)])
-               (elem-proj+blame x))
-             (raise-listof-blame-error blame val (pe-listof-ctc? ctc) #f)))])))
+       (if (im-listof-ctc? ctc)
+           (λ (val) 
+             (let loop ([val val])
+               (cond
+                 [(pair? val)
+                  (cons (elem-proj+blame (car val))
+                        (loop (cdr val)))]
+                 [else (elem-proj+blame val)])))
+           (λ (val)
+             (if (pred? val)
+                 (for/list ([x (in-list val)])
+                   (elem-proj+blame x))
+                 (raise-listof-blame-error blame val (pe-listof-ctc? ctc) #f))))])))
 
 (define (listof-val-first-projection ctc)
   (define elem-proj (get/build-val-first-projection (listof-ctc-elem-c ctc)))
@@ -572,22 +618,43 @@
     (define elem-proj+blame (elem-proj (blame-add-listof-context blame)))
     (cond
       [(flat-listof-ctc? ctc)
-       (λ (val)
-         (if (pred? val)
+       (if (im-listof-ctc? ctc)
+           (λ (val)
              (λ (neg-party)
-               (for ([x (in-list val)])
-                 ((elem-proj+blame x) neg-party))
-               val)
-             (λ (neg-party)
-               (raise-listof-blame-error blame val (pe-listof-ctc? ctc) neg-party))))]
+               (let loop ([val val])
+                 (cond
+                   [(pair? val)
+                    ((elem-proj+blame (car val)) neg-party)
+                    (loop (cdr val))]
+                   [else 
+                    ((elem-proj+blame val) neg-party)]))
+               val))
+           (λ (val)
+             (if (pred? val)
+                 (λ (neg-party)
+                   (for ([x (in-list val)])
+                     ((elem-proj+blame x) neg-party))
+                   val)
+                 (λ (neg-party)
+                   (raise-listof-blame-error blame val (pe-listof-ctc? ctc) neg-party)))))]
       [else
-       (λ (val)
-         (if (pred? val)
-             (λ (neg-party)
-               (for/list ([x (in-list val)])
-                 ((elem-proj+blame x) neg-party)))
-             (λ (neg-party)
-               (raise-listof-blame-error blame val (pe-listof-ctc? ctc) neg-party))))])))
+        (if (im-listof-ctc? ctc)
+            (λ (val)
+              (λ (neg-party)
+                (let loop ([val val])
+                  (cond
+                    [(pair? val)
+                     (cons ((elem-proj+blame (car val)) neg-party)
+                           (loop (cdr val)))]
+                    [else 
+                     ((elem-proj+blame val) neg-party)]))))
+            (λ (val)
+              (if (pred? val)
+                  (λ (neg-party)
+                    (for/list ([x (in-list val)])
+                      ((elem-proj+blame x) neg-party)))
+                  (λ (neg-party)
+                    (raise-listof-blame-error blame val (pe-listof-ctc? ctc) neg-party)))))])))
 
 (define flat-prop
   (build-flat-contract-property
@@ -598,7 +665,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
-   #:list-contract? (λ (c) #t)))
+   #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 (define chap-prop
   (build-chaperone-contract-property
    #:name list-name
@@ -608,7 +675,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
-   #:list-contract? (λ (c) #t)))
+   #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 (define full-prop
   (build-contract-property
    #:name list-name
@@ -618,7 +685,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
-   #:list-contract? (λ (c) #t)))
+   #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 
 (struct listof-ctc (elem-c))
 
@@ -654,9 +721,26 @@
   #:property prop:custom-write custom-write-property-proc
   #:property prop:contract full-prop)
 
+;; improper lists
+(struct im-listof-ctc listof-ctc ())
+
+;; improper, flat
+(struct imf-listof-ctc im-listof-ctc ()
+  #:property prop:custom-write custom-write-property-proc
+  #:property prop:flat-contract flat-prop)
+;; improper, chaperone
+(struct imc-listof-ctc im-listof-ctc ()
+  #:property prop:custom-write custom-write-property-proc
+  #:property prop:chaperone-contract chap-prop)
+;; improper, impersonator
+(struct imi-listof-ctc im-listof-ctc ()
+  #:property prop:custom-write custom-write-property-proc
+  #:property prop:contract full-prop)
+
 (define (flat-listof-ctc? x)
   (or (pef-listof-ctc? x)
-      (nef-listof-ctc? x)))
+      (nef-listof-ctc? x)
+      (imf-listof-ctc? x)))
 
 (define (ne->pe-ctc ne-ctc)
   (define elem-ctc (listof-ctc-elem-c ne-ctc))
@@ -675,11 +759,17 @@
     [(chaperone-contract? c) (nec-listof-ctc c)]
     [else (nei-listof-ctc c)]))
 (define/subexpression-pos-prop (listof raw-c)
-  (define c (coerce-contract 'non-empty-listof raw-c))
+  (define c (coerce-contract 'listof raw-c))
   (cond
     [(flat-contract? c) (pef-listof-ctc c)]
     [(chaperone-contract? c) (pec-listof-ctc c)]
     [else (pei-listof-ctc c)]))
+(define/subexpression-pos-prop (list*of raw-c)
+  (define c (coerce-contract 'list*of raw-c))
+  (cond
+    [(flat-contract? c) (imf-listof-ctc c)]
+    [(chaperone-contract? c) (imc-listof-ctc c)]
+    [else (imi-listof-ctc c)]))
 
 
 (define (blame-add-car-context blame) (blame-add-context blame "the car of"))