diff --git a/default-recommendations.rkt b/default-recommendations.rkt index caf81204..6c624622 100644 --- a/default-recommendations.rkt +++ b/default-recommendations.rkt @@ -33,7 +33,6 @@ resyntax/default-recommendations/loops/list-loopification resyntax/default-recommendations/loops/named-let-loopification resyntax/default-recommendations/match-shortcuts - resyntax/default-recommendations/miscellaneous-suggestions resyntax/default-recommendations/mutability-predicates resyntax/default-recommendations/numeric-shortcuts resyntax/default-recommendations/require-and-provide-suggestions @@ -75,7 +74,6 @@ resyntax/default-recommendations/loops/list-loopification resyntax/default-recommendations/loops/named-let-loopification resyntax/default-recommendations/match-shortcuts - resyntax/default-recommendations/miscellaneous-suggestions resyntax/default-recommendations/mutability-predicates resyntax/default-recommendations/numeric-shortcuts resyntax/default-recommendations/require-and-provide-suggestions @@ -123,7 +121,6 @@ make-temporary-directory-migration match-let-replacement match-shortcuts - miscellaneous-suggestions mutability-predicates named-let-loopification numeric-shortcuts diff --git a/default-recommendations/conditional-shortcuts-test.rkt b/default-recommendations/conditional-shortcuts-test.rkt index 2db1fbb5..5bb0a795 100644 --- a/default-recommendations/conditional-shortcuts-test.rkt +++ b/default-recommendations/conditional-shortcuts-test.rkt @@ -828,3 +828,49 @@ no-change-test: "cond with unshared tail expression not refactorable to when" [else (displayln "false tail")])) -------------------- + + +test: "if with else cond can be flattened to cond" +- (if 'a 'b (cond ['c 'd] ['e 'f])) +------------------------------ +(cond + ['a 'b] + ['c 'd] + ['e 'f]) +------------------------------ + + +test: "cond with else-if can be collapsed" +- (cond ['a 'b] ['c 'd] [else (if 'e 'f 'g)]) +------------------------------ +(cond + ['a 'b] + ['c 'd] + ['e 'f] + [else 'g]) +------------------------------ + + +test: "cond with begin in clause can be simplified" +------------------------------ +(cond ['a (begin 'b 'c 'd)]) +============================== +(cond + ['a + 'b + 'c + 'd]) +------------------------------ + + +test: "cond with begin in middle clause can be simplified" +------------------------------ +(cond ['a 'b] ['c (begin 'd 'e)] ['f 'g]) +============================== +(cond + ['a 'b] + ['c + 'd + 'e] + ['f 'g]) +------------------------------ diff --git a/default-recommendations/conditional-shortcuts.rkt b/default-recommendations/conditional-shortcuts.rkt index 894171ae..2271cc3e 100644 --- a/default-recommendations/conditional-shortcuts.rkt +++ b/default-recommendations/conditional-shortcuts.rkt @@ -91,10 +91,18 @@ #:attributes (negated? condition [body 1]) #:literals (cond void not begin let) - (pattern (cond [(not condition) (void)] [else :block-expression]) #:with negated? #false) - (pattern (cond [(not condition) :block-expression] [else (void)]) #:with negated? #true) - (pattern (cond [condition (void)] [else :block-expression]) #:with negated? #true) - (pattern (cond [condition :block-expression] [else (void)]) #:with negated? #false)) + (pattern (cond [(not condition) (void)] [else block-expr:block-expression]) + #:with negated? #false + #:with (body ...) #'(block-expr.body ...)) + (pattern (cond [(not condition) block-expr:block-expression] [else (void)]) + #:with negated? #true + #:with (body ...) #'(block-expr.body ...)) + (pattern (cond [condition (void)] [else block-expr:block-expression]) + #:with negated? #true + #:with (body ...) #'(block-expr.body ...)) + (pattern (cond [condition block-expr:block-expression] [else (void)]) + #:with negated? #false + #:with (body ...) #'(block-expr.body ...))) (define-refactoring-rule cond-void-to-when-or-unless @@ -236,13 +244,56 @@ tail expression outside `cond` lets you replace `cond` with `when`." body-after ...)) +(define if-begin-to-cond-message + "The `cond` form supports multiple body expressions in each branch, making `begin` unnecessary.") + + +(define-refactoring-rule if-else-cond-to-cond + #:description if-begin-to-cond-message + #:literals (if cond) + (if condition then-branch (cond clause ...)) + (cond [condition then-branch] clause ...)) + + +(define-refactoring-rule cond-else-if-to-cond + #:description "The `else`-`if` branch of this `cond` expression can be collapsed into the `cond`\ + expression." + #:literals (cond else if) + (cond clause ... [else (if inner-condition inner-then-branch else-branch)]) + (cond clause ... [inner-condition inner-then-branch] [else else-branch])) + + +(define-refactoring-rule cond-begin-to-cond + #:description "The bodies of `cond` clauses are already implicitly wrapped in `begin`." + #:literals (cond begin else void) + (cond clause-before ... [condition (begin body ...)] clause-after ...) + ;; Don't match if this is the else clause of a cond that could be converted to when/unless + #:when (not (and (empty? (attribute clause-after)) + (= (length (attribute clause-before)) 1) + (syntax-parse (first (attribute clause-before)) + #:literals (void not) + [(~or [_ (void)] + [(not _) (void)]) #true] + [_ #false]))) + ;; Also don't match if the clause after is [else (void)] + #:when (or (empty? (attribute clause-after)) + (syntax-parse #'(clause-after ...) + #:literals (else void) + [(~not ([else (void)])) #true] + [_ #false])) + (cond clause-before ... [condition body ...] clause-after ...)) + + (define-refactoring-suite conditional-shortcuts #:rules (always-throwing-cond-to-when always-throwing-if-to-when + cond-begin-to-cond cond-else-cond-to-cond + cond-else-if-to-cond cond-void-to-when-or-unless explicit-cond-else-void if-begin-to-cond + if-else-cond-to-cond if-else-false-to-and if-void-to-when-or-unless if-x-else-x-to-and diff --git a/default-recommendations/match-shortcuts-test.rkt b/default-recommendations/match-shortcuts-test.rkt index a6899ca8..487e4a58 100644 --- a/default-recommendations/match-shortcuts-test.rkt +++ b/default-recommendations/match-shortcuts-test.rkt @@ -474,4 +474,34 @@ test: "refactoring list element variable definitions to match-define doesn't ref ------------------------------ +test: "and with match on same identifier can be simplified" +------------------------------ +(define (f x) + (and x (match x [1 2]))) +============================== +(define (f x) + (match x + [#f #f] + [1 2])) +------------------------------ + + +test: "and with match on same identifier preserves formatting" +------------------------------ +(define (foo some-var) + (and some-var + (match some-var + ['first-case 'first-result] + ['second-case 'second-result]))) +============================== +(define (foo some-var) + (match some-var + [#f #f] + ['first-case 'first-result] + ['second-case 'second-result])) +------------------------------ + + +no-change-test: "and with match on different identifiers not refactorable" +- (define (foo x y) (and x (match y ['a 'b] ['c 'd]))) diff --git a/default-recommendations/match-shortcuts.rkt b/default-recommendations/match-shortcuts.rkt index 4f807179..79af706d 100644 --- a/default-recommendations/match-shortcuts.rkt +++ b/default-recommendations/match-shortcuts.rkt @@ -265,8 +265,18 @@ elements than expected." (body-before ... (~focus-replacement-on match-definition) body-after ...)) +(define-refactoring-rule and-match-to-match + #:description "This `and` expression can be turned into a clause of the inner `match` expression,\ + reducing nesting." + #:literals (and match) + (and and-subject:id (match match-subject:id match-clause ...)) + #:when (free-identifier=? #'and-subject #'match-subject) + (match match-subject [#false #false] match-clause ...)) + + (define-refactoring-suite match-shortcuts - #:rules (list-element-definitions-to-match-define + #:rules (and-match-to-match + list-element-definitions-to-match-define match-conditional-to-when predicate-pattern-with-lambda-to-when remove-unnecessary-root-and-pattern diff --git a/default-recommendations/miscellaneous-suggestions.rkt b/default-recommendations/miscellaneous-suggestions.rkt deleted file mode 100644 index 21b466a1..00000000 --- a/default-recommendations/miscellaneous-suggestions.rkt +++ /dev/null @@ -1,77 +0,0 @@ -#lang racket/base - - -(require racket/contract/base) - - -(provide - (contract-out - [miscellaneous-suggestions refactoring-suite?])) - - -(require (for-syntax racket/base) - racket/match - rebellion/private/static-name - resyntax/base - resyntax/private/syntax-replacement - syntax/parse) - - -;@---------------------------------------------------------------------------------------------------- - - -(define if-begin-to-cond-message - "The `cond` form supports multiple body expressions in each branch, making `begin` unnecessary.") - -(define-refactoring-rule if-then-begin-to-cond - #:description if-begin-to-cond-message - #:literals (if begin) - (if condition (begin then-body ...) else-branch) - (cond [condition then-body ...] [else else-branch])) - - -(define-refactoring-rule if-else-begin-to-cond - #:description if-begin-to-cond-message - #:literals (if begin) - (if condition then-branch (begin else-body ...)) - (cond [condition then-branch] [else else-body ...])) - - -(define-refactoring-rule if-else-cond-to-cond - #:description if-begin-to-cond-message - #:literals (if cond) - (if condition then-branch (cond clause ...)) - (cond [condition then-branch] clause ...)) - - -(define-refactoring-rule cond-else-if-to-cond - #:description "The `else`-`if` branch of this `cond` expression can be collapsed into the `cond`\ - expression." - #:literals (cond else if) - (cond clause ... [else (if inner-condition inner-then-branch else-branch)]) - (cond clause ... [inner-condition inner-then-branch] [else else-branch])) - - -(define-refactoring-rule cond-begin-to-cond - #:description "The bodies of `cond` clauses are already implicitly wrapped in `begin`." - #:literals (cond begin) - (cond clause-before ... [condition (begin body ...)] clause-after ...) - (cond clause-before ... [condition body ...] clause-after ...)) - - -(define-refactoring-rule and-match-to-match - #:description "This `and` expression can be turned into a clause of the inner `match` expression,\ - reducing nesting." - #:literals (and match) - (and and-subject:id (match match-subject:id match-clause ...)) - #:when (free-identifier=? #'and-subject #'match-subject) - (match match-subject [#false #false] match-clause ...)) - - -(define-refactoring-suite miscellaneous-suggestions - #:rules (and-match-to-match - cond-begin-to-cond - cond-else-if-to-cond - if-then-begin-to-cond - if-else-begin-to-cond - if-else-cond-to-cond))