diff --git a/collects/redex/private/error.ss b/collects/redex/private/error.ss
new file mode 100644
index 0000000000..62e71b8e3d
--- /dev/null
+++ b/collects/redex/private/error.ss
@@ -0,0 +1,7 @@
+#lang scheme/base
+(define-struct (exn:fail:redex exn:fail) ())
+(define (redex-error name fmt . args)
+  (let ([str (format "~a: ~a" name (apply format fmt args))])
+    (raise (make-exn:fail:redex str (current-continuation-marks)))))
+(provide redex-error
+         exn:fail:redex?)
diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss
index dc757af98b..48a9a4481e 100644
--- a/collects/redex/private/matcher.ss
+++ b/collects/redex/private/matcher.ss
@@ -1307,9 +1307,7 @@ before the pattern compiler is invoked.
     (cond
       [(eq? none s1) s2]
       [(eq? none s2) s1]
-      ;; MF: error message simplified because it is too close to
-      ;; implementation matters. 
-      [(error 'matcher.ss "found two holes" #;s1 #;s2)]))
+      [(error 'matcher.ss "found two holes")]))
   
   ;; reverse-multiples : (listof mtch[to-lists]) -> (listof mtch[to-lists])
   ;; reverses the rhs of each rib in the bindings and reverses the context.
diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index 36bd04e02e..a4d3a466f6 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -4,6 +4,7 @@
          "struct.ss"
          "term.ss"
          "loc-wrapper.ss"
+	 "error.ss"
          (lib "list.ss")
          (lib "etc.ss"))
 
@@ -38,13 +39,15 @@
                      (let ([match (match-pattern cp-x exp)])
                        (when match
                          (unless (null? (cdr match))
-                           (error 'term-match "pattern ~s matched term ~e multiple ways"
-                                  'pattern
-                                  exp))
+                           (redex-error
+			    'term-match/single
+			    "pattern ~s matched term ~e multiple ways"
+			    'pattern
+			    exp))
                          (k (term-let ([names/ellipses (lookup-binding (mtch-bindings (car match)) 'names)] ...)
                               rhs))))
                      ...
-                     (error 'term-match/single "no patterns matched ~e" exp))))))))]))
+                     (redex-error 'term-match/single "no patterns matched ~e" exp))))))))]))
 
 (define-syntax (term-match stx)
   (syntax-case stx ()
@@ -946,7 +949,7 @@
                  (when (null? (cdr more))
                    (raise-syntax-error syn-error-name "expected a range contract to follow the arrow" stx (car more)))
                  (let ([doms (reverse dom-pats)]
-                       [codomain (car more)]
+                       [codomain (cadr more)]
                        [clauses (check-clauses stx syn-error-name (cddr more))])
                    (values doms codomain clauses))]
                 [else
@@ -1010,26 +1013,26 @@
                                      "expected a side-condition or where clause"
                                      (car stuff))])]))]))))
 
-(define (build-metafunction lang patterns rhss old-cps old-rhss wrap dom-contract-pat rng-contract-pat name)
+(define (build-metafunction lang patterns rhss old-cps old-rhss wrap dom-contract-pat codom-contract-pat name)
   (let ([compiled-patterns (append old-cps
                                    (map (λ (pat) (compile-pattern lang pat #t)) patterns))]
         [dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))]
-        [rng-compiled-pattern (compile-pattern lang rng-contract-pat #t)])
+        [codom-compiled-pattern (compile-pattern lang codom-contract-pat #f)])
     (values
      (wrap
       (letrec ([metafunc
                 (λ (exp)
                   (when dom-compiled-pattern
                     (unless (match-pattern dom-compiled-pattern exp)
-                      (error name
-                             "~s is not in my domain"
-                             `(,name ,@exp))))
+                      (redex-error name
+				   "~s is not in my domain"
+				   `(,name ,@exp))))
                   (let loop ([patterns compiled-patterns]
                              [rhss (append old-rhss rhss)]
                              [num (- (length old-cps))])
                     (cond
                       [(null? patterns) 
-                       (error name "no clauses matched for ~s" `(,name . ,exp))]
+                       (redex-error name "no clauses matched for ~s" `(,name . ,exp))]
                       [else
                        (let ([pattern (car patterns)]
                              [rhs (car rhss)])
@@ -1039,14 +1042,17 @@
                                                 (cdr rhss)
                                                 (+ num 1))]
                              [(not (null? (cdr mtchs)))
-                              (error name "~a matched ~s ~a different ways" 
-                                     (if (< num 0)
-                                         "a clause from an extended metafunction"
-                                         (format "clause ~a" num))
-                                     `(,name ,@exp)
-                                     (length mtchs))]
+                              (redex-error name "~a matched ~s ~a different ways" 
+					   (if (< num 0)
+					       "a clause from an extended metafunction"
+					       (format "clause ~a" num))
+					   `(,name ,@exp)
+					   (length mtchs))]
                              [else
-                              (rhs metafunc (mtch-bindings (car mtchs)))])))])))])
+                              (let ([ans (rhs metafunc (mtch-bindings (car mtchs)))])
+                                (unless (match-pattern codom-compiled-pattern ans)
+                                  (redex-error name "codomain test failed for ~s, call was ~s" ans `(,name ,@exp)))
+                                ans)])))])))])
         metafunc)
       compiled-patterns
       rhss)
diff --git a/collects/redex/private/tl-test.ss b/collects/redex/private/tl-test.ss
index ebc38402aa..7bf2f400ef 100644
--- a/collects/redex/private/tl-test.ss
+++ b/collects/redex/private/tl-test.ss
@@ -409,6 +409,52 @@
     (test (term (f p q)) (term p))
     (test (in-domain? (f p q)) #t))
   
+  (let ()
+    (define-metafunction empty-language
+      [(err number_1 ... number_2 ...) 1])
+    (test (term (err)) 1)
+    (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                          ((λ (x) #t) (λ (x) 'wrong-exn)))
+            (term (err 1 2))
+            'no-exn)
+          'right-exn))
+  
+  (let ()
+    (define-metafunction empty-language
+      err : number ... -> number
+      [(err number ...) 1])
+    (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                          ((λ (x) #t) (λ (x) 'wrong-exn)))
+            (term (err #f #t))
+            'no-exn)
+          'right-exn))
+  
+  (let ()
+    (define-metafunction empty-language
+      err : number ... -> number
+      [(err number ...) #f])
+    (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                          ((λ (x) #t) (λ (x) 'wrong-exn)))
+            (term (err 1 2))
+            'no-exn)
+          'right-exn))
+  
+  (let ()
+    (define-metafunction empty-language
+      err : number ... -> (number number)
+      [(err number ...) (number ...)])
+    (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                          ((λ (x) #t) (λ (x) 'wrong-exn)))
+            (term (err 1 2))
+            'no-exn)
+          'no-exn)
+    (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                          ((λ (x) #t) (λ (x) 'wrong-exn)))
+            (term (err 1 1))
+            'no-exn)
+          'no-exn))
+    
+  
 
 ;                                                                                                                                
 ;                                                                                                                                
@@ -426,6 +472,7 @@
 ;                                                                                                                                
 
   
+  
   (test (apply-reduction-relation
          (reduction-relation 
           grammar
@@ -869,7 +916,7 @@
   (require (lib "list.ss"))
   (let ()
     (define-metafunction lc-lang
-      free-vars : e -> (listof x)
+      free-vars : e -> (x ...)
       [(free-vars (e_1 e_2 ...))
        (∪ (free-vars e_1) (free-vars e_2) ...)]
       [(free-vars x) (x)]
@@ -938,6 +985,28 @@
          '(x y))
         '(x . y))
   
+
+  (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                        ((λ (x) #t) (λ (x) 'wrong-exn)))
+          ((term-match/single empty-language
+                              [(number_1 ... number_2 ...) 1])
+           '(1 2 3))
+          'no-exn)
+        'right-exn)
+  
+  (test (with-handlers ((exn:fail:redex? (λ (x) 'right-exn))
+                        ((λ (x) #t) (λ (x) 'wrong-exn)))
+          ((term-match/single empty-language
+                              [(number_1 ... number_2 ...) 1])
+           'x)
+          'no-exn)
+        'right-exn)
+  
+  (test ((term-match empty-language
+                     [(number_1 ... number_2 ...) 1])
+         'x)
+        '())
+                             
   (define-language x-is-1-language
     [x 1])
   
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index e67cdb9cc2..1153996238 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -467,6 +467,9 @@ expressions and checks them against each pattern. The
 function returns the expression behind the first sucessful
 match. If that pattern produces multiple matches, an error
 is signaled. If no patterns match, an error is signaled.
+
+Raises an exception recognized by @scheme[exn:fail:redex?] if
+no clauses match or if one of the clauses matches multiple ways.
 }
 
 @defproc[(plug [context any?] [expression any?]) any]{
@@ -496,6 +499,11 @@ Does not expect the input symbols to be distinct, but does
 produce variables that are always distinct.
 }
 
+@defproc[(exn:fail:redex? [v any/c]) boolean?]{
+  Returns @scheme[#t] if its argument is a Redex exception record, and
+  @scheme[#f] otherwise.
+}
+
 @section{Languages}
 
 All of the exports in this section are provided both by
@@ -820,12 +828,16 @@ argument to each side-condition should be a Scheme
 expression, and the pattern variables in the <pattern> are
 bound in that expression.
 
+Raises an exception recognized by @scheme[exn:fail:redex?] if
+no clauses match, if one of the clauses matches multiple ways, or
+if the contract is violated.
+
 As an example, these metafunctions finds the free variables in
 an expression in the lc-lang above:
 
 @schemeblock[
     (define-metafunction lc-lang
-      free-vars : e -> (listof x)
+      free-vars : e -> (x ...)
       [(free-vars (e_1 e_2 ...))
        (∪ (free-vars e_1) (free-vars e_2) ...)]
       [(free-vars x) (x)]
diff --git a/collects/redex/reduction-semantics.ss b/collects/redex/reduction-semantics.ss
index 7b681d65c7..96885b50e4 100644
--- a/collects/redex/reduction-semantics.ss
+++ b/collects/redex/reduction-semantics.ss
@@ -4,10 +4,13 @@
 (require "private/reduction-semantics.ss"
          "private/matcher.ss"
          "private/term.ss"
-         "private/rg.ss")
+         "private/rg.ss"
+         "private/error.ss")
 
 #;(provide (all-from-out "private/rg.ss"))
 
+(provide exn:fail:redex?) ;; from error.ss
+
 (provide reduction-relation 
          --> fresh with ;; keywords for reduction-relation
          extend-reduction-relation