diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt
index 23ba5588f3..bf1b65b398 100644
--- a/collects/redex/private/reduction-semantics.rkt
+++ b/collects/redex/private/reduction-semantics.rkt
@@ -1697,53 +1697,66 @@
             stx
             #'id)))]))
 
-;; pull-out-names : symbol syntax -> list-of-syntax[identifier identifier-or-false]
-(define-for-syntax (pull-out-names form stx ids)
-  (let loop ([names (syntax->list ids)]
-             [acc '()])
-    (cond
-      [(null? names) acc]
-      [else
-       (let* ([name (car names)]
-              [lst (syntax->list name)])
-         (cond
-           [(identifier? name) (loop (cdr names) (cons #`(#,(syntax-e name) #f) acc))]
-           [(and (list? lst)
-                 (andmap identifier? lst))
-            (loop (cdr names) (append 
-                               (list #`(#,(car lst) #f))
-                               (map (λ (x) #`(#,(syntax-e x) #,(car lst)))
-                                    (cdr lst))
-                               acc))]
-           [(list? lst)
-            (for-each (λ (x) (unless (identifier? x)
-                               (raise-syntax-error form "expected an identifier" stx x)))
-                      lst)]
-           [else
-            (raise-syntax-error form 
-                                "expected an identifier or a sequence of identifiers"
-                                stx
-                                name)]))])))
+(define-syntax (::= stx)
+  (raise-syntax-error #f "cannot be used outside a language definition" stx))
 
-;; check-rhss-not-empty : syntax (listof syntax) -> void
-(define-for-syntax (check-rhss-not-empty def-lang-stx nt-def-stxs)
-  (for-each 
-   (λ (nt-def-stx)
-     (when (null? (cdr (syntax-e nt-def-stx)))
-       (raise-syntax-error 'define-language "non-terminal with no productions" def-lang-stx nt-def-stx)))
-   nt-def-stxs))
+(define-for-syntax (parse-non-terminals nt-defs stx)
+  (define (parse-non-terminal def)
+    (define (delim? stx)
+      (and (identifier? stx) (free-identifier=? stx #'::=)))
+    (define-values (left delim right)
+      (syntax-case def ()
+        [(_ _ ...)
+         (let split ([xs def])
+           (syntax-case xs (::=)
+             [() (values '() #f '())]
+             [(x . prods)
+              (delim? #'x)
+              (values '() #'x (syntax->list #'prods))]
+             [(x . xs)
+              (let-values ([(l d r) (split #'xs)])
+                (values (cons #'x l) d r))]))]
+        [_ (raise-syntax-error #f "expected non-terminal definition" stx def)]))
+    (define (check-each xs bad? msg)
+      (define x (findf bad? xs))
+      (when x (raise-syntax-error #f msg stx x)))
+    (define-values (names prods)
+      (if delim
+          (begin
+            (when (null? left)
+              (raise-syntax-error #f "expected preceding non-terminal names" stx delim))
+            (values left right))
+          (values (syntax-case (car left) ()
+                    [(x ...) (syntax->list #'(x ...))]
+                    [x (list #'x)])
+                  (cdr left))))
+    
+    (check-each names (λ (x) (not (identifier? x)))
+                "expected non-terminal name")
+    (check-each names (λ (x) (memq (syntax-e x) (cons 'name underscore-allowed)))
+                "cannot use pattern language keyword as a non-terminal name")
+    (check-each names (λ (x) (regexp-match? #rx"_" (symbol->string (syntax-e x))))
+                "cannot use _ in a non-terminal name")
+    
+    (when (null? prods)
+      (raise-syntax-error #f "expected at least one production to follow" 
+                          stx (or delim (car left))))
+    (check-each prods delim? "expected production")
+    (cons names prods))
+  (map parse-non-terminal (syntax->list nt-defs)))
 
 (define-syntax (define-language stx)
   (syntax-case stx ()
-    [(_ name (names rhs ...) ...)
-     (identifier? (syntax name))
+    [(_ lang-name . nt-defs)
      (begin
-       (check-rhss-not-empty stx (cddr (syntax->list stx)))
-       (with-syntax ([((nt-names orig) ...) (pull-out-names 'define-language stx #'(names ...))])
-         (with-syntax ([(subst-names ...) (generate-temporaries (syntax->list #'(nt-names ...)))])
+       (unless (identifier? #'lang-name)
+         (raise-syntax-error #f "expected an identifier" stx #'lang-name))
+       (let ([non-terms (parse-non-terminals #'nt-defs stx)])
+         (with-syntax ([((names prods ...) ...) non-terms]
+                       [(all-names ...) (apply append (map car non-terms))])
            (syntax/loc stx
              (begin
-               (define-syntax name
+               (define-syntax lang-name
                  (make-set!-transformer
                   (make-language-id
                    (case-lambda
@@ -1754,62 +1767,17 @@
                         [x 
                          (identifier? #'x)
                          #'define-language-name])])
-                   '(nt-names ...))))
-               (define define-language-name (language name (names rhs ...) ...)))))))]))
+                   '(all-names ...))))
+               (define define-language-name (language lang-name (all-names ...) (names prods ...) ...)))))))]))
 
 (define-struct binds (source binds))
 
 (define-syntax (language stx)
   (syntax-case stx ()
-    [(_ lang-id (name rhs ...) ...)
+    [(_ lang-id (all-names ...) (name rhs ...) ...)
      (prune-syntax
       (let ()
-        
-        ;; verify `name' part has the right shape
-        (for-each
-         (λ (name)
-           (cond
-             [(identifier? name) (void)]
-             [else
-              (let ([lst (syntax->list name)])
-                (cond 
-                  [(list? lst) 
-                   (when (null? lst)
-                     (raise-syntax-error 'language 
-                                         "expected a sequence of identifiers with at least one identifier"
-                                         stx
-                                         name))
-                   (for-each (λ (x) (unless (identifier? x)
-                                      (raise-syntax-error 'language 
-                                                          "expected an identifier"
-                                                          stx
-                                                          x)))
-                             lst)]
-                  [else
-                   (raise-syntax-error 'language 
-                                       "expected a sequence of identifiers"
-                                       stx
-                                       lst)]))]))
-         (syntax->list #'(name ...)))
-        (let ([all-names (apply append (map (λ (x) (if (identifier? x) (list x) (syntax->list x))) 
-                                            (syntax->list #'(name ...))))])
-          ;; verify the names are valid names
-          (for-each 
-           (λ (name) 
-             (let ([x (syntax->datum name)])
-               (when (memq x '(any number string variable natural integer real variable-except variable-prefix hole name in-hole hide-hole side-condition cross ...))
-                 (raise-syntax-error 'language 
-                                     (format "cannot use pattern language keyword ~a as non-terminal"
-                                             x)
-                                     stx
-                                     name))
-               (when (regexp-match #rx"_" (symbol->string x))
-                 (raise-syntax-error 'language
-                                     "non-terminals cannot have _ in their names"
-                                     stx
-                                     name))))
-           all-names)
-          
+        (let ([all-names (syntax->list #'(all-names ...))])
           (with-syntax ([((r-rhs ...) ...) 
                          (map (lambda (rhss) 
                                 (map (lambda (rhs)
@@ -1869,37 +1837,22 @@
                   (compile-language (list (list '(uniform-names ...) rhs/lw ...) ...)
                                     (list (make-nt 'first-names (list (make-rhs `r-rhs) ...)) ...
                                           (make-nt 'new-name (list (make-rhs 'orig-name))) ...)
-                                    '((uniform-names ...) ...)))))))))]
-    [(_ (name rhs ...) ...)
-     (for-each
-      (lambda (name)
-        (unless (identifier? name)
-          (raise-syntax-error 'language "expected name" stx name)))
-      (syntax->list (syntax (name ...))))]
-    [(_ x ...)
-     (for-each
-      (lambda (x)
-        (syntax-case x ()
-          [(name rhs ...)
-           (void)]
-          [_
-           (raise-syntax-error 'language "malformed non-terminal" stx x)]))
-      (syntax->list (syntax (x ...))))]))
+                                    '((uniform-names ...) ...)))))))))]))
 
 (define-syntax (define-extended-language stx)
   (syntax-case stx ()
-    [(_ name orig-lang (names rhs ...) ...)
+    [(_ name orig-lang . nt-defs)
      (begin
        (unless (identifier? (syntax name))
          (raise-syntax-error 'define-extended-language "expected an identifier" stx #'name))
        (unless (identifier? (syntax orig-lang))
          (raise-syntax-error 'define-extended-language "expected an identifier" stx #'orig-lang))
-       (check-rhss-not-empty stx (cdddr (syntax->list stx)))
-       (let ([old-names (language-id-nts #'orig-lang 'define-extended-language)])
-         (with-syntax ([((new-nt-names orig) ...) (append (pull-out-names 'define-extended-language stx #'(names ...)) 
-                                                          (map (λ (x) #`(#,x #f)) old-names))])
+       (let ([old-names (language-id-nts #'orig-lang 'define-extended-language)]
+             [non-terms (parse-non-terminals #'nt-defs stx)])
+         (with-syntax ([((names prods ...) ...) non-terms]
+                       [(all-names ...) (apply append old-names (map car non-terms))])
            #'(begin
-               (define define-language-name (extend-language orig-lang (names rhs ...) ...))
+               (define define-language-name (extend-language orig-lang (all-names ...) (names prods ...) ...))
                (define-syntax name
                  (make-set!-transformer
                   (make-language-id
@@ -1910,28 +1863,15 @@
                        [x 
                         (identifier? #'x)
                         #'define-language-name]))
-                   '(new-nt-names ...))))))))]))
+                   '(all-names ...))))))))]))
 
 (define-syntax (extend-language stx)
   (syntax-case stx ()
-    [(_ lang (name rhs ...) ...)
-     (and (identifier? #'lang)
-          (andmap (λ (names) 
-                    (syntax-case names ()
-                      [(name1 name2 ...)
-                       (and (identifier? #'name1)
-                            (andmap identifier? (syntax->list #'(name2 ...))))
-                       #t]
-                      [name
-                       (identifier? #'name) 
-                       #t]
-                      [_ #f]))
-                  (syntax->list (syntax/loc stx (name ...)))))
+    [(_ lang (all-names ...) (name rhs ...) ...)
      (with-syntax ([((r-rhs ...) ...) (map (lambda (rhss) (map (λ (x) (rewrite-side-conditions/check-errs
                                                                        (append (language-id-nts #'lang 'define-extended-language)
-                                                                               (map (λ (x) (syntax-case x ()
-                                                                                             [(x y) (syntax-e #'x)]))
-                                                                                    (pull-out-names 'define-extended-language stx #'(name ...))))
+                                                                               (map syntax-e
+                                                                                    (syntax->list #'(all-names ...))))
                                                                        'define-extended-language
                                                                        #f
                                                                        x))
@@ -1939,9 +1879,6 @@
                                            (syntax->list (syntax ((rhs ...) ...))))]
                    [((rhs/lw ...) ...) (map (lambda (rhss) (map to-lw/proc (syntax->list rhss)))
                                             (syntax->list (syntax ((rhs ...) ...))))]
-                   [(first-names ...)
-                    (map (λ (x) (if (identifier? x) x (car (syntax->list x))))
-                         (syntax->list (syntax (name ...))))]
                    [((uniform-names ...) ...)
                     (map (λ (x) (if (identifier? x) (list x) x))
                          (syntax->list (syntax (name ...))))]
@@ -1959,33 +1896,7 @@
        (syntax/loc stx
          (do-extend-language lang 
                              (list (make-nt '(uniform-names ...) (list (make-rhs `r-rhs) ...)) ...)
-                             (list (list '(uniform-names ...) rhs/lw ...) ...))))]
-    [(_ lang (name rhs ...) ...)
-     (begin
-       (unless (identifier? #'lang)
-         (error 'define-extended-language "expected the name of a language" stx #'lang))
-       (for-each
-        (lambda (name)
-          (unless (syntax-case name ()
-                    [(name1 name2 ...)
-                     (and (identifier? #'name1)
-                          (andmap identifier? #'(name2 ...)))
-                     #t]
-                    [name
-                     (identifier? #'name)
-                     #t]
-                    [else #f])
-            (raise-syntax-error 'define-extended-language "expected a name or a non-empty sequence of names" stx name)))
-        (syntax->list (syntax (name ...)))))]
-    [(_ lang x ...)
-     (for-each
-      (lambda (x)
-        (syntax-case x ()
-          [(name rhs ...)
-           (void)]
-          [_
-           (raise-syntax-error 'define-extended-language "malformed non-terminal" stx x)]))
-      (syntax->list (syntax (x ...))))]))
+                             (list (list '(uniform-names ...) rhs/lw ...) ...))))]))
 
 (define extend-nt-ellipses '(....))
 
@@ -2336,7 +2247,7 @@
                [else #f]))))
 
 (provide (rename-out [-reduction-relation reduction-relation])
-         --> fresh with ;; keywords for reduction-relation
+         --> fresh with ::= ;; macro keywords
          reduction-relation->rule-names
          extend-reduction-relation
          reduction-relation?
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index 0f736fe16a..b81af99ac4 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -584,9 +584,10 @@ all non-GUI portions of Redex) and also exported by
 @racketmodname[redex] (which includes all of Redex).
 
 @defform/subs[(define-language lang-name 
-                (non-terminal-spec @#,ttpattern ...)
-                ...)
-              ([non-terminal-spec symbol (symbol ...)])]{
+                non-terminal-def ...)
+              ([non-terminal-def (non-terminal-name ...+ ::= @#,ttpattern ...+)
+                                 (non-terminal-name @#,ttpattern ...+)
+                                 ((non-terminal-name ...+) @#,ttpattern ...+)])]{
 
 This form defines the grammar of a language. It allows the
 definition of recursive @|pattern|s, much like a BNF, but for
@@ -595,10 +596,9 @@ power, however, because repeated @racket[name] @|pattern|s and
 side-conditions can restrict matches in a context-sensitive
 way.
 
-The non-terminal-spec can either by a symbol, indicating a
-single name for this non-terminal, or a sequence of symbols,
-indicating that all of the symbols refer to these
-productions.
+A @racket[non-terminal-def] comprises one or more non-terminal names
+(considered aliases) followed by one or more productions. A non-terminal's
+names and productions may be separated by the keyword @racket[::=].
 
 As a simple example of a grammar, this is the lambda
 calculus:
@@ -618,9 +618,11 @@ with non-terminals @racket[e] for the expression language, @racket[x] for
 variables, @racket[c] for the evaluation contexts and @racket[v] for values.
 }
 
-@defform[(define-extended-language language language
-           (non-terminal @#,ttpattern ...)
-           ...)]{
+@defform/subs[(define-extended-language extended-lang base-lang 
+                non-terminal-def ...)
+              ([non-terminal-def (non-terminal-name ...+ ::= @#,ttpattern ...+)
+                                 (non-terminal-name @#,ttpattern ...+)
+                                 ((non-terminal-name ...+) @#,ttpattern ...+)])]{
 
 This form extends a language with some new, replaced, or
 extended non-terminals. For example, this language:
diff --git a/collects/redex/reduction-semantics.rkt b/collects/redex/reduction-semantics.rkt
index 4f8e83b577..9e1351b7f1 100644
--- a/collects/redex/reduction-semantics.rkt
+++ b/collects/redex/reduction-semantics.rkt
@@ -12,6 +12,7 @@
 (provide reduction-relation 
          --> fresh with ;; keywords for reduction-relation
          hole in-hole ;; keywords for term
+         ::= ;; keywords for language definition
          extend-reduction-relation
          reduction-relation?
          
diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt
index 57f8ccc5a7..399d7561f5 100644
--- a/collects/redex/tests/tl-test.rkt
+++ b/collects/redex/tests/tl-test.rkt
@@ -321,6 +321,31 @@
     (test (and (redex-match E v (term ((bar 1) 1))) #t) #t)
     (test (redex-match E v (term ((bar 1) 2))) #f))
   
+  (let ()
+    (define-language L
+      (M N ::= (M N) (λ (x) M) x)
+      (x ::= variable-not-otherwise-mentioned))
+    (test (and (redex-match L M '(λ (x) (x x))) #t) #t)
+    (test (and (redex-match L N '(λ (x) (x x))) #t) #t)
+    (define-extended-language L+ L
+      (M ::= .... n)
+      (n m ::= number))
+    (test (and (redex-match L+ M '(λ (x) 7)) #t) #t)
+    (test (and (redex-match L+ m 7) #t) #t)
+    (let ([::= void])
+      (define-language L
+        (::= () (number ::=)))
+      (test (and (redex-match L ::= '(1 ())) #t) #t)))
+  
+  (test-syn-err (define-language (L)) #rx"expected an identifier")
+  (test-syn-err (define-language L (x ::=)) #rx"expected at least one production")
+  (test-syn-err (define-language L (x)) #rx"expected at least one production")
+  (test-syn-err (define-language L ((x))) #rx"expected at least one production")
+  (test-syn-err (define-language L (::= a b)) #rx"expected preceding non-terminal names")
+  (test-syn-err (define-language L (x (y) ::= z)) #rx"expected non-terminal name")
+  (test-syn-err (define-language L (x ::= y ::= z)) #rx"expected production")
+  (test-syn-err (define-language L q) #rx"expected non-terminal definition")
+  (test-syn-err (define-language L ()) #rx"expected non-terminal definition")
 ;                                                                                             
 ;                                                                                             
 ;                                 ;;;                                ;                        
@@ -1394,12 +1419,12 @@
   
   (test-syn-err (define-language bad-lang1 (e name)) #rx"name")
   (test-syn-err (define-language bad-lang2 (name x)) #rx"name")
-  (test-syn-err (define-language bad-lang3 (x_y x)) #rx"cannot have _")
-  (test-syn-err (define-language bad-lang4 (a 1 2) (b)) #rx"no productions")
+  (test-syn-err (define-language bad-lang3 (x_y x)) #rx"cannot use _")
+  (test-syn-err (define-language bad-lang4 (a 1 2) (b)) #rx"at least one production")
   (test-syn-err (let ()
                   (define-language good-lang (a 1 2))
                   (define-extended-language bad-lang5 good-lang (a) (b 2)))
-                #rx"no productions")
+                #rx"at least one production")
   
   (test-syn-err (redex-match grammar m_1) #rx"before underscore")
   (test-syn-err (redex-match grammar (variable-except a 2 c)) #rx"expected an identifier")