diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt
index 49c433d2a2..e2e6d8c193 100644
--- a/collects/lang/private/rewrite-error-message.rkt
+++ b/collects/lang/private/rewrite-error-message.rkt
@@ -51,6 +51,57 @@
           (if (and (not (= found:n 0)) fn-is-large) "only " "")
           (if (= found:n 0) "none" found:n)))
 
+(define (format-enum conj l)
+  (if (= (length l) 2)
+      (format "~a ~a ~a" (car l) conj (cadr l))
+      (apply string-append
+             (let loop ([l l])
+               (cond
+                [(null? (cdr l)) l]
+                [(null? (cddr l))
+                 (list* (car l) ", " conj " " (loop (cdr l)))]
+                [else
+                 (list* (car l) ", " (loop (cdr l)))])))))
+
+(define (contract-to-desc ctc)
+  (with-handlers ([exn:fail:read? (lambda (exn) ctc)])
+    (define s (read (open-input-string ctc)))
+    (let loop ([s s])
+      (cond
+       [(not s) "false"]
+       [(and (symbol? s) (regexp-match? #rx"[?]$" (symbol->string s)))
+        (define str (symbol->string s))
+        (format "a~a ~a"
+                (if (and ((string-length str) . > . 0)
+                         (memv (string-ref str 0) '(#\a #\e #\i #\o #\u)))
+                    "n"
+                    "")
+                (substring str 0 (sub1 (string-length str))))]
+       [(null? s) "an impossible value"]
+       [(not (list? s)) ctc] ;; ???
+       [(eq? 'or/c (car s))
+        (format-enum "or" (map loop (cdr s)))]
+       [(eq? 'and/c (car s))
+        (string-append "a value that is " (format-enum "and" (map loop (cdr s))))]
+       [(eq? 'not/c (car s))
+        (format "a value that is not ~a" (loop (cadr s)))]
+       [(and (eq? '>/c (car s)) (zero? (cadr s)))
+        "a positive number"]
+       [(and (eq? '</c (car s)) (zero? (cadr s)))
+        "a negative number"]
+       [(and (eq? '>=/c (car s)) (zero? (cadr s)))
+        "a non-negative number"]
+       [else ctc]))))
+
+(define (contract-error-message ctc given pos)
+  (define d (contract-to-desc ctc))
+  (format "expects ~a~a~a~a, given ~a"
+          d
+          (if pos " as " "")
+          (or pos "")
+          (if pos " argument" "")
+          given))
+
 (define (rewrite-contract-error-message msg)
   (define replacements
     (list (list #rx"application: expected procedure\n  given: ([^\n]*)(?:\n  arguments: [[]none[]])?"
@@ -68,6 +119,8 @@
                 (lambda (all one two three) (argcount-error-message one two three #t)))
           (list #px"application: wrong number of arguments.*\n  procedure: ([^\n]*)\n  expected[^:]*: (\\d+)\n  given[^:]*: (\\d+)(?:\n  arguments:(?:\n   [^\n]*)*)?"
                 (lambda (all one two three) (argcount-error-message one two three)))
+          (list #px"contract violation\n  expected: (.*?)\n  given: ([^\n]*)(?:\n  argument position: ([^\n]*))?(?:\n  other arguments:.*)?"
+                (lambda (all ctc given pos) (contract-error-message ctc given pos)))
           (list #rx"^procedure "
                 (lambda (all) ""))
           (list #rx", given: "
diff --git a/collects/tests/htdp-lang/beg-adv.rktl b/collects/tests/htdp-lang/beg-adv.rktl
index cae0c85102..2c89111628 100644
--- a/collects/tests/htdp-lang/beg-adv.rktl
+++ b/collects/tests/htdp-lang/beg-adv.rktl
@@ -2,7 +2,9 @@
 (htdp-err/rt-test (add1) "add1: expects 1 argument, but found none")
 (htdp-err/rt-test (add1 'a 'b 'c) "add1: expects only 1 argument, but found 3")
 (htdp-err/rt-test (define x x) "x is used here before its definition")
-(htdp-err/rt-test (add1 'a) "add1: contract violation")
+(htdp-err/rt-test (add1 'a) "add1: expects a number, given 'a")
+(htdp-err/rt-test (+ 'a 1) "[+]: expects a number as 1st argument, given 'a")
+(htdp-err/rt-test (+ 1 'a) "[+]: expects a number as 2nd argument, given 'a")
 
 (htdp-syntax-test #'() "function call: expected a function after the open parenthesis, but nothing's there")
 
@@ -80,7 +82,7 @@
 (htdp-test #t 'a3? (a3? (make-a3 1 2 3)))
 (htdp-test #f 'a1? (a1? (make-a3 1 2 3)))
 (htdp-test #f 'a3? (a3? (make-a1 1)))
-(htdp-err/rt-test (a1-b 10) "a1-b: contract violation\n  expected: a1[?]\n  given: 10")
+(htdp-err/rt-test (a1-b 10) "a1-b: expects an a1, given 10")
 (htdp-syntax-test #'(a0 1 2 3) "a0: expected a function after the open parenthesis, but found a structure name")
 
 (htdp-syntax-test #'cond "cond: expected an open parenthesis before cond, but found none")
diff --git a/collects/tests/htdp-lang/bega-adv.rktl b/collects/tests/htdp-lang/bega-adv.rktl
index 6c7c1c2f23..585344b376 100644
--- a/collects/tests/htdp-lang/bega-adv.rktl
+++ b/collects/tests/htdp-lang/bega-adv.rktl
@@ -28,4 +28,4 @@
 (htdp-syntax-test #'unquote-splicing "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
 (htdp-syntax-test #'(unquote-splicing (list 10)) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
 
-(htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: contract violation\n  expected: list?\n  given: 4"))
+(htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: expects a list, given 4"))