diff --git a/default-recommendations.rkt b/default-recommendations.rkt index dd32c8a..7057092 100644 --- a/default-recommendations.rkt +++ b/default-recommendations.rkt @@ -37,6 +37,7 @@ resyntax/default-recommendations/mutability-predicates resyntax/default-recommendations/numeric-shortcuts resyntax/default-recommendations/require-and-provide-suggestions + resyntax/default-recommendations/simplify-named-let-initialization resyntax/default-recommendations/string-shortcuts resyntax/default-recommendations/syntax-shortcuts resyntax/default-recommendations/syntax-parse-shortcuts @@ -79,6 +80,7 @@ resyntax/default-recommendations/mutability-predicates resyntax/default-recommendations/numeric-shortcuts resyntax/default-recommendations/require-and-provide-suggestions + resyntax/default-recommendations/simplify-named-let-initialization resyntax/default-recommendations/string-shortcuts resyntax/default-recommendations/syntax-parse-shortcuts resyntax/default-recommendations/syntax-rules-shortcuts @@ -129,6 +131,7 @@ numeric-shortcuts provide-contract-migration require-and-provide-suggestions + simplify-named-let-initialization string-shortcuts syntax-shortcuts syntax-parse-shortcuts diff --git a/default-recommendations/simplify-named-let-initialization-test.rkt b/default-recommendations/simplify-named-let-initialization-test.rkt new file mode 100644 index 0000000..caecace --- /dev/null +++ b/default-recommendations/simplify-named-let-initialization-test.rkt @@ -0,0 +1,52 @@ +#lang resyntax/test + + +require: resyntax/default-recommendations simplify-named-let-initialization + + +header: +-------------------- +#lang racket +(define (a) 1) +(define (b) 2) +(define (c) 3) +-------------------- + +test: "original code should be refactorable to new code" +-------------------- +(define (f a b c) + (let loop ([x (+ 1 2 3)] + [y (if (a) + (b) + (c))]) + (loop x y))) +==================== +(define (f a b c) + (define init-y + (if (a) + (b) + (c))) + (let loop ([x (+ 1 2 3)] + [y init-y]) + (loop x y))) +-------------------- + + +no-change-test: "code not refactorable when side-effecting expression is present" +-------------------- +(define (f a b c) + (let loop ([x (displayln "foo")] + [y (if (a) + (b) + (c))]) + (loop x y))) +-------------------- + + +no-change-test: "code not refactorable when all expressions are single-line" +-------------------- +(define (f a b c) + (let loop ([x (+ 1 2 3)] + [y 42]) + (loop x y))) +-------------------- diff --git a/default-recommendations/simplify-named-let-initialization.rkt b/default-recommendations/simplify-named-let-initialization.rkt new file mode 100644 index 0000000..5102cc2 --- /dev/null +++ b/default-recommendations/simplify-named-let-initialization.rkt @@ -0,0 +1,67 @@ +#lang racket/base + + +(require racket/contract/base) + + +(provide + (contract-out + [simplify-named-let-initialization refactoring-suite?])) + + +(require racket/list + racket/syntax + resyntax/base + resyntax/default-recommendations/private/definition-context + resyntax/default-recommendations/private/pure-expression + resyntax/default-recommendations/private/syntax-lines + syntax/parse) + + +;@---------------------------------------------------------------------------------------------------- + + +(define-definition-context-refactoring-rule simplify-named-let-initialization-rule + #:description + "Complex multi-line initialization expressions in named `let` loops can be extracted into `define`\ + bindings to improve readability." + #:literals (let) + (~seq leading-body ... + (let loop-name:id ([binding-id:id binding-expr:expr] ...) + loop-body ...)) + + #:do [(define-values (bindings-to-extract remaining-bindings) + (for/fold ([extracted '()] + [remaining '()]) + ([id (in-list (attribute binding-id))] + [expr (in-list (attribute binding-expr))]) + (if (multiline-syntax? expr) + (values (cons (list id expr) extracted) + remaining) + (values extracted + (cons (list id expr) remaining)))))] + + ;; Check that at least one binding expression is multi-line + #:when (not (null? bindings-to-extract)) + + ;; Check that all non-multi-line (remaining) binding expressions are pure + ;; (so we can safely reorder by extracting the multi-line ones) + #:when (for/and ([binding (in-list remaining-bindings)]) + (syntax-parse (cadr binding) + [:pure-expression #true] + [_ #false])) + + #:with ((extracted-id extracted-expr) ...) (reverse bindings-to-extract) + #:with ((kept-id kept-expr) ...) (reverse remaining-bindings) + #:with (init-id ...) (for/list ([id (in-list (attribute extracted-id))]) + (format-id id "init-~a" id)) + + (leading-body ... + (define init-id extracted-expr) ... + (let loop-name ([kept-id kept-expr] ... + [extracted-id init-id] ...) + loop-body ...))) + + +(define-refactoring-suite simplify-named-let-initialization + #:rules (simplify-named-let-initialization-rule))