Add refactoring rules to suggest define-syntax-parse-rule over verbose macro forms (#740)

Co-authored-by: copilot-swe-agent[bot] <[email protected]>
Co-authored-by: jackfirth <[email protected]>
Co-authored-by: Jack Firth <[email protected]>

Author: Copilot

default-recommendations/syntax-parse-shortcuts-test.rkt

@@ -0,0 +1,86 @@
+#lang resyntax/test
+
+
+require: resyntax/default-recommendations syntax-parse-shortcuts
+
+
+header:
+------------------------------
+#lang racket/base
+(require (for-syntax racket/base syntax/parse)
+         syntax/parse/define)
+------------------------------
+
+
+test: "define-syntax with syntax-parse and one clause refactorable to define-syntax-parse-rule"
+------------------------------
+(define-syntax my-or
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ a b)
+       #'(let ([tmp a]) (if tmp tmp b))])))
+==============================
+(define-syntax-parse-rule (my-or a b)
+  (let ([tmp a]) (if tmp tmp b)))
+------------------------------
+
+
+test: "define-syntax-parser with one clause refactorable to define-syntax-parse-rule"
+------------------------------
+(define-syntax-parser my-or
+  [(_ a b)
+   #'(let ([tmp a]) (if tmp tmp b))])
+==============================
+(define-syntax-parse-rule (my-or a b)
+  (let ([tmp a]) (if tmp tmp b)))
+------------------------------
+
+
+test: "define-syntax with syntax-parse using stx name refactorable to define-syntax-parse-rule"
+------------------------------
+(define-syntax my-macro
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ x:id)
+       #'(quote x)])))
+==============================
+(define-syntax-parse-rule (my-macro x:id)
+  (quote x))
+------------------------------
+
+
+test: "define-syntax with syntax-parse using custom name in directives replaced with this-syntax"
+------------------------------
+(define-syntax my-macro
+  (lambda (input-stx)
+    (syntax-parse input-stx
+      [(_ x:id)
+       #:with loc input-stx
+       #'(quote (x loc))])))
+==============================
+(define-syntax-parse-rule (my-macro x:id)
+  #:with loc this-syntax
+  (quote (x loc)))
+------------------------------
+
+
+no-change-test: "define-syntax with syntax-parse and multiple clauses not refactorable"
+------------------------------
+(define-syntax my-or
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ a b)
+       #'(let ([tmp a]) (if tmp tmp b))]
+      [(_ a)
+       #'a])))
+------------------------------
+
+
+no-change-test: "define-syntax-parser with multiple clauses not refactorable"
+------------------------------
+(define-syntax-parser my-or
+  [(_ a b)
+   #'(let ([tmp a]) (if tmp tmp b))]
+  [(_ a)
+   #'a])
+------------------------------

default-recommendations/syntax-parse-shortcuts.rkt

@@ -9,11 +9,63 @@
   [syntax-parse-shortcuts refactoring-suite?]))
 
 
-(require resyntax/base)
+(require (for-syntax racket/base
+                     syntax/parse)
+         rebellion/private/static-name
+         resyntax/base
+         resyntax/private/more-syntax-parse-classes
+         resyntax/private/syntax-traversal
+         racket/stream
+         syntax/parse
+         syntax/parse/define)
 
 
 ;@----------------------------------------------------------------------------------------------------
 
 
+(define-refactoring-rule define-syntax-syntax-parse-to-define-syntax-parse-rule
+  #:description
+  "This `define-syntax` macro with a single `syntax-parse` clause can be replaced with a simpler,
+equivalent `define-syntax-parse-rule` macro."
+  #:literals (define-syntax lambda [syntax-parse syntax-parse #:phase 1] [syntax-id syntax #:phase 1])
+  
+  (define-syntax macro:id
+    (lambda (stx-id:id)
+      (syntax-parse stx-id2:id
+        [(_ pattern ...) directive:syntax-parse-pattern-directive ... (syntax-id last-form)])))
+  
+  #:when (free-identifier=? (attribute stx-id) (attribute stx-id2) 1)
+
+  #:with (new-body ...)
+  (syntax-traverse #'((~@ . directive) ... last-form)
+    [id-in-body:id
+     #:when (free-identifier=? (attribute id-in-body) (attribute stx-id) 1)
+     (syntax-property #'this-syntax 'skip-incorrect-binding-check? #true)])
+  
+  (define-syntax-parse-rule (macro pattern ...) new-body ...))
+
+
+(define-refactoring-rule define-syntax-parser-to-define-syntax-parse-rule-simple
+  #:description
+  "This `define-syntax-parser` macro with a single clause can be replaced with a simpler, equivalent
+`define-syntax-parse-rule` macro."
+  #:literals (define-syntax-parser)
+  
+  (define-syntax-parser macro:id
+    [(_ . pattern) body ...])
+  
+  #:do [(define (strip-syntax-wrapper stx)
+          (syntax-parse stx
+            #:literals (syntax)
+            [(syntax body) #'body]
+            [other #'other]))
+        (define new-body (map strip-syntax-wrapper (attribute body)))]
+  
+  #:with (new-body-part ...) new-body
+  
+  (define-syntax-parse-rule (macro . pattern) new-body-part ...))
+
+
 (define-refactoring-suite syntax-parse-shortcuts
-  #:rules ())
+  #:rules (define-syntax-syntax-parse-to-define-syntax-parse-rule
+           define-syntax-parser-to-define-syntax-parse-rule-simple))

private/syntax-replacement.rkt

@@ -360,7 +360,9 @@
     ;; Without the fix, the formatter would allow the code to exceed the line length limit.
     ;; With the fix, the formatter either keeps it on one line within the limit, or breaks it
     ;; across multiple lines if it cannot fit.
-    (define orig-line "      [`(,(and (or '+ '- '* '/ 'and 'or) op) ,as ..2 ,b) `(,op ,(loop `(,op ,@as) env) ,(loop b env))]")
+    (define orig-line
+      (string-append "      [`(,(and (or '+ '- '* '/ 'and 'or) op) ,as ..2 ,b)"
+                     " `(,op ,(loop `(,op ,@as) env) ,(loop b env))]"))
     (check-equal? (string-length orig-line) 102 "Original line should be 102 characters")
 
     ;; The quasiquote expression starts at position 57 and ends at position 101
@@ -370,9 +372,10 @@
     (define quasiquote-end 101) ; just before the final ]
 
     (define replacement
-      (string-replacement #:start quasiquote-start
-                          #:end quasiquote-end
-                          #:contents (list (inserted-string "(list op (loop `(,op ,@as) env) (loop b env))"))))
+      (string-replacement
+       #:start quasiquote-start
+       #:end quasiquote-end
+       #:contents (list (inserted-string "(list op (loop `(,op ,@as) env) (loop b env))"))))
 
     ;; Test with Racket's standard line width of 102
     (parameterize ([current-width 102])
@@ -383,7 +386,8 @@
       ;; If it's multi-line, each line should not exceed 102 characters
       (for ([line (in-list (string-split result "\n"))])
         (check-true (<= (string-length line) 102)
-                    (format "Line exceeds length limit: ~a chars (should be <= 102)" (string-length line)))))))
+                    (format "Line exceeds length limit: ~a chars (should be <= 102)"
+                            (string-length line)))))))
 
 
 (define (syntax-replacement-introduces-incorrect-bindings? replacement)
@@ -392,7 +396,8 @@
                                     #:introduction-scope intro)
     replacement)
   (for/and ([new-id (in-syntax-identifiers new)]
-            #:unless (bound-identifier=? new-id (intro new-id 'remove)))
+            #:unless (bound-identifier=? new-id (intro new-id 'remove))
+            #:unless (syntax-property new-id 'skip-incorrect-binding-check?))
     (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id)))))
 
 
@@ -403,7 +408,8 @@
     replacement)
   (for/list ([new-id (in-syntax-identifiers new)]
              #:unless (bound-identifier=? new-id (intro new-id 'remove))
-             #:unless (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id))))
+             #:unless (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id)))
+             #:unless (syntax-property new-id 'skip-incorrect-binding-check?))
     new-id))