Add null-when-guard-to-match-pattern rule

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]))
+------------------------------
+

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))