diff --git a/collects/redex/private/matcher.rkt b/collects/redex/private/matcher.rkt index d57a830826..a2be03894e 100644 --- a/collects/redex/private/matcher.rkt +++ b/collects/redex/private/matcher.rkt @@ -1624,7 +1624,18 @@ See match-a-pattern.rkt for more details [(null? rhss) (if (null? ans) #f - ans)] + (begin + (when (check-redudancy) + (let ([rd (remove-duplicates ans)]) + (unless (= (length rd) (length ans)) + (eprintf "found redundancy when matching the non-terminal ~s against:\n~s~a" + nt + term + (apply + string-append + (map (λ (x) (format "\n ~s" x)) + ans)))))) + ans))] [else (let ([mth (call-nt-proc/bindings (car rhss) term hole-info)]) (cond @@ -1644,6 +1655,8 @@ See match-a-pattern.rkt for more details (or (call-nt-proc/bindings (car rhss) term hole-info) (loop (cdr rhss)))])))) +(define check-redudancy (make-parameter #f)) + (define (match-nt/boolean list-rhs non-list-rhs nt term) (let loop ([rhss (if (or (null? term) (pair? term)) list-rhs @@ -1956,4 +1969,5 @@ See match-a-pattern.rkt for more details the-not-hole the-hole hole? rewrite-ellipses build-compatible-context-language - caching-enabled?) + caching-enabled? + check-redudancy) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 18ce506ad9..134dcdcb58 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -389,7 +389,17 @@ nested lists. } @defproc[(set-cache-size! [size positive-integer?]) void?]{ -Changes the size of the per-pattern and per-metafunction caches. The default size is @racket[350]. +Changes the size of the per-pattern and per-metafunction caches. + +The default size is @racket[350]. +} + +@defparam[check-redudancy check? boolean?]{ + Ambiguous patterns can slow down + Redex's pattern matching implementation significantly. To help debug + such performance issues, set the @racket[check-redundancy] + parameter to @racket[#t]. This causes Redex to, at runtime, + report any redundant matches that it encounters. } @section{Terms} diff --git a/collects/redex/reduction-semantics.rkt b/collects/redex/reduction-semantics.rkt index ab13796c2d..27bae98c19 100644 --- a/collects/redex/reduction-semantics.rkt +++ b/collects/redex/reduction-semantics.rkt @@ -33,7 +33,8 @@ judgment-holds in-domain? caching-enabled? - make-coverage) + make-coverage + check-redudancy) (provide (rename-out [test-match redex-match]) term-match