Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add define-definition-context-refactoring-rule #261

Merged
merged 1 commit into from
Sep 2, 2024
Merged

Add define-definition-context-refactoring-rule #261

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
77 changes: 10 additions & 67 deletions default-recommendations/conditional-shortcuts.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
42 changes: 5 additions & 37 deletions default-recommendations/definition-shortcuts.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
75 changes: 13 additions & 62 deletions default-recommendations/let-binding-suggestions.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
39 changes: 6 additions & 33 deletions default-recommendations/match-shortcuts.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
52 changes: 50 additions & 2 deletions refactoring-rule.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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?)]
Expand All @@ -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
Expand Down Expand Up @@ -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 ...
Expand All @@ -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])))
Loading