From fe391df7d05c37a6b1541b9cf1e352736d31fe21 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Sun, 1 Sep 2024 19:21:57 -0700 Subject: [PATCH] Add `define-definition-context-refactoring-rule` This makes it a lot easier to write more rules that target definition contexts. --- .../conditional-shortcuts.rkt | 77 +++---------------- .../definition-shortcuts.rkt | 42 ++-------- .../let-binding-suggestions.rkt | 75 ++++-------------- default-recommendations/match-shortcuts.rkt | 39 ++-------- refactoring-rule.rkt | 52 ++++++++++++- 5 files changed, 84 insertions(+), 201 deletions(-) diff --git a/default-recommendations/conditional-shortcuts.rkt b/default-recommendations/conditional-shortcuts.rkt index a3c58b4..df810fe 100644 --- a/default-recommendations/conditional-shortcuts.rkt +++ b/default-recommendations/conditional-shortcuts.rkt @@ -108,42 +108,13 @@ #'((~if condition.negated? when unless) condition.base-condition fail))) -;; This syntax class exists solely so that the always-throwing-if-to-when rule can match two cases -;; that are shaped very differently. -(define-syntax-class expresion-matching-always-throwing-if-to-when - #:attributes (refactored) - - (pattern (header:header-form-allowing-internal-definitions - body-before ... - throwing-if:always-throwing-if-expression) - #:with refactored - #'(header.original ... - body-before ... - throwing-if.equivalent-guard-expression - throwing-if.success-expression)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause - [clause-header - body-before ... - throwing-if:always-throwing-if-expression]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header - body-before ... - throwing-if.equivalent-guard-expression - throwing-if.success-expression] - #:original original-clause) - clause-after ...))) - - -(define-refactoring-rule always-throwing-if-to-when +(define-definition-context-refactoring-rule always-throwing-if-to-when #:description "Using `when` and `unless` is simpler than a conditional with an always-throwing branch." - [expression:expresion-matching-always-throwing-if-to-when expression.refactored]) + [(~seq body-before ... throwing-if:always-throwing-if-expression) + (body-before ... + throwing-if.equivalent-guard-expression + throwing-if.success-expression)]) (define-syntax-class always-throwing-cond-expression @@ -156,41 +127,13 @@ #'(((~if condition.negated? unless when) condition.base-condition fail) ...))) -;; This syntax class exists solely so that the always-throwing-cond-to-when rule can match two cases -;; that are shaped very differently. -(define-syntax-class expression-matching-always-throwing-cond-to-when - #:attributes (refactored) - - (pattern (header:header-form-allowing-internal-definitions - body-before ... - throwing-cond:always-throwing-cond-expression) - #:with refactored - #'(header.original ... - body-before ... - throwing-cond.guard-expression ... - throwing-cond.body ...)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause - [clause-header - body-before ... - throwing-cond:always-throwing-cond-expression]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header - body-before ... - throwing-cond.guard-expression ... - throwing-cond.body ...] - #:original original-clause) - clause-after ...))) - -(define-refactoring-rule always-throwing-cond-to-when +(define-definition-context-refactoring-rule always-throwing-cond-to-when #:description "Using `when` and `unless` is simpler than a conditional with an always-throwing branch." - [expression:expression-matching-always-throwing-cond-to-when expression.refactored]) + [(~seq body-before ... throwing-cond:always-throwing-cond-expression) + (body-before ... + throwing-cond.guard-expression ... + throwing-cond.body ...)]) (define-refactoring-rule cond-else-cond-to-cond diff --git a/default-recommendations/definition-shortcuts.rkt b/default-recommendations/definition-shortcuts.rkt index 6654e12..07d1e59 100644 --- a/default-recommendations/definition-shortcuts.rkt +++ b/default-recommendations/definition-shortcuts.rkt @@ -21,45 +21,13 @@ ;@---------------------------------------------------------------------------------------------------- -;; This syntax class exists solely so that the define-values-values-to-define rule can match two cases -;; that are shaped very differently. -(define-syntax-class expresion-matching-define-values-values-to-define - #:attributes (refactored) - #:literals (define-values values) - - (pattern (header:header-form-allowing-internal-definitions - body-before ... - (define-values (id:id ...) (values expr:expr ...)) - body-after ...) - #:with refactored - #'(header.original ... - body-before ... - (define id expr) ... - body-after ...)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause - [clause-header - body-before ... - (define-values (id:id ...) (values expr:expr ...)) - body-after ...]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header - body-before ... - (define id expr) ... - body-after ...] - #:original original-clause) - clause-after ...))) - - -(define-refactoring-rule define-values-values-to-define +(define-definition-context-refactoring-rule define-values-values-to-define #:description "This use of `define-values` is unnecessary." #:literals (define-values values) - [expression:expresion-matching-define-values-values-to-define expression.refactored]) + [(~seq body-before ... + (define-values (id:id ...) (values expr:expr ...)) + body-after ...) + (body-before ... (define id expr) ... body-after ...)]) (define definition-shortcuts diff --git a/default-recommendations/let-binding-suggestions.rkt b/default-recommendations/let-binding-suggestions.rkt index 3332b86..db6330f 100644 --- a/default-recommendations/let-binding-suggestions.rkt +++ b/default-recommendations/let-binding-suggestions.rkt @@ -37,31 +37,10 @@ ;@---------------------------------------------------------------------------------------------------- -;; This syntax class exists solely so that the let-to-define rule can match two cases that are shaped -;; very differently. -(define-syntax-class expresion-matching-let-to-define - #:attributes (refactored) - - (pattern (header:header-form-allowing-internal-definitions - let-expr:body-with-refactorable-let-expression) - #:with refactored - #'(header.original ... let-expr.refactored ...)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause [clause-header let-expr:body-with-refactorable-let-expression]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header let-expr.refactored ...] #:original original-clause) - clause-after ...))) - - -(define-refactoring-rule let-to-define +(define-definition-context-refactoring-rule let-to-define #:description "Internal definitions are recommended instead of `let` expressions, to reduce nesting." - [expression:expresion-matching-let-to-define expression.refactored]) + [let-expr:body-with-refactorable-let-expression (let-expr.refactored ...)]) (define-refactoring-rule named-let-to-plain-let @@ -85,46 +64,18 @@ (call-with-values (λ () expr) receiver)]) -(define-splicing-syntax-class define-with-nested-let-and-body - #:attributes ([refactored 1]) - #:literals (define let) - (pattern (~seq body-before ... - (define id:id (let ([nested-id:id nested-expr:expr]) expr:expr)) - body-after ...) - #:when (not (set-member? (syntax-bound-identifiers #'(body-before ... id body-after ...)) - #'nested-id)) - #:with (refactored ...) - #'(body-before ... - (define nested-id nested-expr) - (define id expr) - body-after ...))) - - -;; This syntax class exists solely so that the define-let-to-double-define rule can match two cases -;; that are shaped very differently. -(define-syntax-class expression-matching-define-let-to-double-define - #:attributes (refactored) - - (pattern (header:header-form-allowing-internal-definitions - define-with-let:define-with-nested-let-and-body) - - #:with refactored - #'(header.original ... define-with-let.refactored ...)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause [clause-header define-with-let:define-with-nested-let-and-body]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header define-with-let.refactored ...] #:original original-clause) - clause-after ...))) - - -(define-refactoring-rule define-let-to-double-define +(define-definition-context-refactoring-rule define-let-to-double-define #:description "This `let` expression can be pulled up into a `define` expression." - [expression:expression-matching-define-let-to-double-define expression.refactored]) + #:literals (define let) + [(~seq body-before ... + (define id:id (let ([nested-id:id nested-expr:expr]) expr:expr)) + body-after ...) + #:when (not + (set-member? (syntax-bound-identifiers #'(body-before ... id body-after ...)) #'nested-id)) + (body-before ... + (define nested-id nested-expr) + (define id expr) + body-after ...)]) (define-refactoring-rule delete-redundant-let diff --git a/default-recommendations/match-shortcuts.rkt b/default-recommendations/match-shortcuts.rkt index 8cc2506..6081e6f 100644 --- a/default-recommendations/match-shortcuts.rkt +++ b/default-recommendations/match-shortcuts.rkt @@ -26,40 +26,13 @@ ;@---------------------------------------------------------------------------------------------------- -(define-splicing-syntax-class single-clause-match-expression-with-body - #:attributes ([refactored 1]) - #:literals (match) - (pattern (~seq body-before ... (match subject [pattern body-after ...])) - #:when (set-empty? (set-intersect (syntax-bound-identifiers #'(body-before ...)) - (syntax-bound-identifiers #'pattern))) - #:with (refactored ...) - #'(body-before ... (match-define pattern subject) body-after ...))) - - -;; This syntax class exists solely so that the single-clause-match-to-match-define rule can match two -;; cases that are shaped very differently. -(define-syntax-class expression-matching-single-clause-match-to-match-define - #:attributes (refactored) - - (pattern (header:header-form-allowing-internal-definitions - body:single-clause-match-expression-with-body) - #:with refactored - #'(header.original ... body.refactored ...)) - - (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses - clause-before ... - (~and original-clause [clause-header body:single-clause-match-expression-with-body]) - clause-after ...) - #:with refactored - #'(branching-header.original ... - clause-before ... - (~replacement [clause-header body.refactored ...] #:original original-clause) - clause-after ...))) - - -(define-refactoring-rule single-clause-match-to-match-define +(define-definition-context-refactoring-rule single-clause-match-to-match-define #:description "This `match` expression can be simplified using `match-define`." - [expression:expression-matching-single-clause-match-to-match-define expression.refactored]) + #:literals (match) + [(~seq body-before ... (match subject [pattern body-after ...])) + #:when (set-empty? (set-intersect (syntax-bound-identifiers #'(body-before ...)) + (syntax-bound-identifiers #'pattern))) + (body-before ... (match-define pattern subject) body-after ...)]) (define match-shortcuts diff --git a/refactoring-rule.rkt b/refactoring-rule.rkt index f8a7ddc..51aa48c 100644 --- a/refactoring-rule.rkt +++ b/refactoring-rule.rkt @@ -6,6 +6,7 @@ (provide define-refactoring-rule + define-definition-context-refactoring-rule (contract-out [refactoring-rule? predicate/c] [refactoring-rule-description (-> refactoring-rule? immutable-string?)] @@ -20,10 +21,12 @@ (option/c syntax-replacement?))]))) -(require (for-syntax racket/base) +(require (for-syntax racket/base + racket/syntax) rebellion/base/immutable-string rebellion/base/option rebellion/type/object + resyntax/default-recommendations/private/definition-context resyntax/private/source resyntax/private/syntax-replacement resyntax/private/syntax-neighbors @@ -62,7 +65,7 @@ #:introduction-scope rule-introduction-scope)))) -(define-simple-macro +(define-syntax-parse-rule (define-refactoring-rule id:id #:description description parse-option ... @@ -79,3 +82,48 @@ parse-option ... [pattern pattern-directive ... (present #'replacement)] [_ absent])))))) + + +(define-syntax-parse-rule + (define-definition-context-refactoring-rule id:id + #:description (~var description (expr/c #'string?)) + parse-option ... + [splicing-pattern pattern-directive ... (splicing-replacement ...)]) + + ;; These identifiers are macro-introduced, but we use format-id on them anyway so that the expanded + ;; code is more readable and it's clearer which refactoring rule these syntax classes are derived + ;; from. + #:with body-matching-id (format-id #'macro-introduced-context "body-matching-~a" #'id) + #:with expression-matching-id (format-id #'macro-introduced-context "expression-matching-~a" #'id) + + (begin + + (define-splicing-syntax-class body-matching-id + #:attributes ([refactored 1]) + parse-option ... + (pattern splicing-pattern + pattern-directive ... + #:with (refactored (... ...)) #'(splicing-replacement ...))) + + (define-syntax-class expression-matching-id + #:attributes (refactored) + + (pattern (header:header-form-allowing-internal-definitions (~var body body-matching-id)) + #:cut + #:with refactored #'(header.original (... ...) body.refactored (... ...))) + + (pattern (branching-header:branching-form-allowing-internal-definitions-within-clauses + clause-before (... ...) + (~and original-clause [clause-header (~var body body-matching-id)]) + clause-after (... ...)) + #:cut + #:with refactored + #'(branching-header.original + (... ...) + clause-before (... ...) + (~replacement [clause-header body.refactored (... ...)] #:original original-clause) + clause-after (... ...)))) + + (define-refactoring-rule id + #:description description + [(~var expression expression-matching-id) expression.refactored])))