added a cycle check to define-language so grammars like this one:

(define-language L
     (e e))

are rejected as syntax errors

collects/redex/private/cycle-check.rkt

@@ -0,0 +1,49 @@
+#lang racket/base
+(require racket/match)
+
+(provide check-for-cycles)
+
+;; doesn't check for cycles via things like:
+;;  a ::= hole
+;;  b ::= (in-hole a b)
+(define (check-for-cycles stx ntss/stx prodss/stx)
+  
+  (define ntss (syntax->datum ntss/stx))
+  (define prodss (syntax->datum prodss/stx))
+  
+  ;; hash[sym[nt] -o> (listof sym[nt])
+  (define table (make-hash))
+  
+  ;; build the graph
+  (for ([nts (in-list ntss)]
+        [prods (in-list prodss)])
+    (define base-nt (car nts))
+    (for ([nt (in-list (cdr nts))])
+      (hash-set! table nt (list base-nt)))
+    (hash-set! table base-nt '())
+    (for ([prod (in-list prods)])
+      (match prod
+        [`(nt ,name)
+         (hash-set! table base-nt (cons name (hash-ref table base-nt)))]
+        [_ (void)])))
+  
+  ;; traverse the graph looking for cycles
+  (define cycle
+    (for/or ([(nt neighbors) (in-hash table)])
+      (define visited (make-hash))
+      (for/or ([neighbor (in-list neighbors)]) 
+        (let loop ([current-node neighbor])
+          (cond
+            [(eq? current-node nt) nt]
+            [(hash-ref visited current-node #f) #f]
+            [else
+             (hash-set! visited current-node #t)
+             (for/or ([neighbor (in-list (hash-ref table current-node))])
+               (loop neighbor))])))))
+  
+  (when cycle
+    (raise-syntax-error 'define-language
+                        (format
+                         "found a cycle that includes the non-terminal ~a"
+                         cycle)
+                        stx)))

collects/redex/private/reduction-semantics.rkt

@@ -6,6 +6,7 @@
          "fresh.rkt"
          "loc-wrapper.rkt"
          "error.rkt"
+         (for-syntax "cycle-check.rkt")
          racket/trace
          racket/contract
          racket/list
@@ -2369,7 +2370,7 @@
          (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
+             (quasisyntax/loc stx
                (begin
                  (define-syntax lang-name
                    (make-set!-transformer
@@ -2383,10 +2384,12 @@
                           (identifier? #'x)
                           #'define-language-name]))
                      '(all-names ...))))
-                 (define define-language-name (language form-name lang-name (all-names ...) (names prods ...) ...))))))))]))
+                 (define define-language-name
+                   #,(syntax/loc stx (language form-name lang-name (all-names ...) (names prods ...) ...)))))))))]))
 
 (define-struct binds (source binds))
 
+  
 (define-syntax (language stx)
   (syntax-case stx ()
     [(_ form-name lang-id (all-names ...) (name rhs ...) ...)
@@ -2420,6 +2423,7 @@
                               (append (loop (car stx))
                                       (loop (cdr stx)))]
                              [else '()]))])
+            (check-for-cycles stx #'(name ...) #'((r-rhs ...) ...))
             (with-syntax ([(the-stx ...) (cdr (syntax-e stx))]
                           [(all-names ...) all-names]
                           [((uniform-names ...) ...)