diff --git a/default-recommendations/match-shortcuts-test.rkt b/default-recommendations/match-shortcuts-test.rkt index b0c50b4..0e39c4f 100644 --- a/default-recommendations/match-shortcuts-test.rkt +++ b/default-recommendations/match-shortcuts-test.rkt @@ -505,3 +505,120 @@ test: "and with match on same identifier preserves formatting" no-change-test: "and with match on different identifiers not refactorable" - (define (foo x y) (and x (match y ['a 'b] ['c 'd]))) + +test: "#:when guard checking a trailing pattern variable is empty foldable into the pattern" +------------------------------ +(define (f x) + (match x + [(list 'array elems ...) + #:when (null? elems) + #f] + [(list 'array elems ...) (length elems)] + [_ 'other])) +============================== +(define (f x) + (match x + [(list 'array) #f] + [(list 'array elems ...) (length elems)] + [_ 'other])) +------------------------------ + + +test: "#:when guard using empty? foldable into the match pattern" +------------------------------ +(require racket/list) +(define (f x) + (match x + [(list 'array elems ...) + #:when (empty? elems) + #f] + [_ 'other])) +============================== +(require racket/list) +(define (f x) + (match x + [(list 'array) #f] + [_ 'other])) +------------------------------ + + +test: "#:when null? guard on ___ ellipsis pattern foldable into the pattern" +------------------------------ +(define (f x) + (match x + [(list 'array elems ___) + #:when (null? elems) + #f] + [_ 'other])) +============================== +(define (f x) + (match x + [(list 'array) #f] + [_ 'other])) +------------------------------ + + +test: "#:when null? guard on sole pattern variable leaves empty list pattern" +------------------------------ +(define (f x) + (match x + [(list elems ...) + #:when (null? elems) + 'empty] + [_ 'other])) +============================== +(define (f x) + (match x + [(list) 'empty] + [_ 'other])) +------------------------------ + + +no-change-test: "#:when null? guard not foldable when the trailing variable is used in the body" +------------------------------ +(define (f x) + (match x + [(list 'array elems ...) + #:when (null? elems) + elems] + [_ 'other])) +------------------------------ + + +no-change-test: "#:when null? guard not foldable when the ellipsis requires at least one element" +------------------------------ +(define (f x) + (match x + [(list 'array elems ..1) + #:when (null? elems) + #f] + [_ 'other])) +------------------------------ + + +no-change-test: "#:when null? guard not foldable when checking a different variable" +------------------------------ +(define (f x ys) + (match x + [(list 'array elems ...) + #:when (null? ys) + #f] + [_ 'other])) +------------------------------ + + +test: "#:when null? guard foldable when the pattern contains a quoted symbol with the same name" +------------------------------ +(define (f x) + (match x + [(list 'elems elems ...) + #:when (null? elems) + #f] + [_ 'other])) +============================== +(define (f x) + (match x + [(list 'elems) #f] + [_ 'other])) +------------------------------ + diff --git a/default-recommendations/match-shortcuts.rkt b/default-recommendations/match-shortcuts.rkt index bfc429b..b20617c 100644 --- a/default-recommendations/match-shortcuts.rkt +++ b/default-recommendations/match-shortcuts.rkt @@ -227,6 +227,46 @@ clause-after ...)) +(define-syntax-class zero-or-more-match-ellipsis + #:literals (...) + (pattern ...) + (pattern id:id + #:when (equal? (symbol->string (syntax-e #'id)) "___"))) + + +(define-syntax-class empty-list-test + #:attributes (subject) + #:literals (null? empty?) + (pattern ((~or null? empty?) subject:id))) + + +(define-refactoring-rule null-when-guard-to-match-pattern + #:description + "This `#:when` condition can be expressed directly by this clause's `match` pattern." + #:literals (match list) + + (match subject + clause-before ... + (~and [(list subpattern ... tail-var:id :zero-or-more-match-ellipsis) + #:when guard:empty-list-test + body ...+] + clause-to-replace) + clause-after ...) + + ; Repeated pattern variables aren't allowed alongside ellipses in match patterns, so the trailing + ; variable can't occur anywhere else in the pattern and only the body needs to be checked for uses. + #:when (free-identifier=? (attribute tail-var) (attribute guard.subject)) + #:when (not (syntax-find-first #'(body ...) + id:id + #:when (free-identifier=? (attribute id) (attribute tail-var)))) + #:with new-clause #'[(list subpattern ...) body ...] + + (match subject + clause-before ... + (~replacement new-clause #:original clause-to-replace) + clause-after ...)) + + (define-syntax-class list-ref-expr #:attributes (list-id index) #:literals (list-ref first second third fourth fifth sixth seventh eighth ninth tenth) @@ -280,6 +320,7 @@ elements than expected." #:rules (and-match-to-match list-element-definitions-to-match-define match-conditional-to-when + null-when-guard-to-match-pattern predicate-pattern-with-lambda-to-when remove-unnecessary-root-and-pattern single-clause-match-to-match-define))