From d1ba8c95d701245e1dc1b825b50e1f46c4de17cd Mon Sep 17 00:00:00 2001 From: Burke Fetscher Date: Fri, 25 Apr 2014 14:52:28 -0500 Subject: [PATCH] redex: don't treat _ as a binder in extract-names Closes PR 14466 --- .../redex/private/rewrite-side-conditions.rkt | 7 ++++--- .../redex-test/redex/tests/tl-test.rkt | 19 +++++++++++++++++-- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/rewrite-side-conditions.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/rewrite-side-conditions.rkt index c0de07df96..d84122a6ce 100644 --- a/pkgs/redex-pkgs/redex-lib/redex/private/rewrite-side-conditions.rkt +++ b/pkgs/redex-pkgs/redex-lib/redex/private/rewrite-side-conditions.rkt @@ -536,9 +536,10 @@ (syntax (rest dots)))]))) (define (binds? nts bind-names? x) - (or (and bind-names? (memq (syntax-e x) nts)) - (and bind-names? (memq (syntax-e x) underscore-allowed)) - (regexp-match #rx"_" (symbol->string (syntax-e x))))) + (and (not (eq? '_ (syntax-e x))) + (or (and bind-names? (memq (syntax-e x) nts)) + (and bind-names? (memq (syntax-e x) underscore-allowed)) + (regexp-match #rx"_" (symbol->string (syntax-e x)))))) (define (binds-in-right-hand-side? nts bind-names? x) (and (binds? nts bind-names? x) diff --git a/pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt b/pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt index 1f9ce9c62d..caf1db7e61 100644 --- a/pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt +++ b/pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt @@ -569,8 +569,23 @@ (add-minuses 11 count))))) '())) (test (< cpu 1000) #t)) - - + +(let () + ;; _ as a non-binding match + (define-language L) + + (test (pair? (redex-match L _ '(1 2 3))) + #t) + (test (redex-match L (_ _) '(1 2 3)) + #f) + (test (pair? (redex-match L (_ _ ...)'(1 2))) + #t) + (test (redex-match L (_ _ ...)'()) + #f) + (test (pair? (redex-match L (_ (_ _ ...) ...) '((1 2) (3 4) (5 6)))) + '#t) + (test (redex-match L (_ (_ _ ...) ...) '((1 2) (3 4) () (5 6))) + #f)) ;