50 lines
1.5 KiB
Racket
50 lines
1.5 KiB
Racket
#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)))
|