From 1c6ea08788038dec68547c243cbcff72013b9742 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Sun, 1 Sep 2024 21:32:49 -0700 Subject: [PATCH] Add `for/fold-result-keyword` rule. (#266) Closes #215. This rule specifically only targets the case where `for/fold` is used with `define-values` and exactly one of the result values is used. That seems like the most common and easily fixable case. Additionally, this change improves the logging for suggestions that have binding problems. Some names are also changed to make it clearer what's going on. --- .../for-loop-shortcuts-test.rkt | 24 ++++++++++++ .../for-loop-shortcuts.rkt | 31 ++++++++++++++++ main.rkt | 9 +++-- private/syntax-replacement.rkt | 37 +++++++++++++------ 4 files changed, 87 insertions(+), 14 deletions(-) diff --git a/default-recommendations/for-loop-shortcuts-test.rkt b/default-recommendations/for-loop-shortcuts-test.rkt index c2eba49..84a545a 100644 --- a/default-recommendations/for-loop-shortcuts-test.rkt +++ b/default-recommendations/for-loop-shortcuts-test.rkt @@ -301,6 +301,30 @@ test: "for*/fold building hash can't be refactored when referring to hash" ------------------------------ +test: "multi-accumulator for/fold with one used result refactorable to for/fold using #:result" +------------------------------ +(define (foo) + (define-values (x y z) + (for/fold ([accum1 0] + [accum2 0] + [accum3 0]) + ([n (in-naturals)]) + (values 0 0 0))) + (* x 2)) +------------------------------ +------------------------------ +(define (foo) + (define x + (for/fold ([accum1 0] + [accum2 0] + [accum3 0] + #:result accum1) + ([n (in-naturals)]) + (values 0 0 0))) + (* x 2)) +------------------------------ + + test: "list->vector with for/list to for/vector" ------------------------------ (list->vector diff --git a/default-recommendations/for-loop-shortcuts.rkt b/default-recommendations/for-loop-shortcuts.rkt index e6b1782..1348dc5 100644 --- a/default-recommendations/for-loop-shortcuts.rkt +++ b/default-recommendations/for-loop-shortcuts.rkt @@ -211,6 +211,36 @@ (loop iteration-clauses body ... (values key value))]) +(define-definition-context-refactoring-rule for/fold-result-keyword + #:description + "Only one of the `for/fold` expression's result values is used. Use the `#:result` keyword to \ +return just that result." + #:literals (define-values for/fold for*/fold) + [(~seq body-before ... + (~and original-definition + (define-values (result-id:id ...) + ((~or for-id:for/fold for-id:for*/fold) + ([accumulator-id:id initializer:expr] ...) + loop-clauses loop-body ...))) + body-after ...) + #:do [(define used-ids + (for/list ([id (in-list (attribute result-id))] + #:when (set-member? (syntax-free-identifiers #'(body-after ...)) id)) + id))] + #:when (equal? (length used-ids) 1) + #:cut + #:do [(define used-index (index-of (attribute result-id) (first used-ids))) + (define used-accumulator (list-ref (attribute accumulator-id) used-index))] + #:with replacement-definition + #`(define #,(first used-ids) + (for-id ([accumulator-id initializer] ... + #:result #,used-accumulator) + loop-clauses loop-body ...)) + (body-before ... + (~replacement replacement-definition #:original original-definition) + body-after ...)]) + + (define-syntax-class nested-for #:attributes ([clause 1] [body 1]) @@ -309,6 +339,7 @@ apply-append-for-loop-to-for-loop apply-plus-to-for/sum for/fold-building-hash-to-for/hash + for/fold-result-keyword for-each-to-for list->set-to-for/set list->vector-to-for/vector diff --git a/main.rkt b/main.rkt index c503ca1..03ccb3d 100644 --- a/main.rkt +++ b/main.rkt @@ -58,10 +58,13 @@ (guard-match (present replacement) (refactoring-rule-refactor rule syntax #:analysis analysis) #:else absent) - (guard (syntax-replacement-preserves-free-identifiers? replacement) #:else + (guard (syntax-replacement-introduces-incorrect-bindings? replacement) #:else (log-resyntax-error - "~a: suggestion discarded because it does not preserve all free identifiers" - (object-name rule)) + (string-append + "~a: suggestion discarded because it introduces identifiers with incorrect bindings\n" + " incorrect identifiers: ~a") + (object-name rule) + (syntax-replacement-introduced-incorrect-identifiers replacement)) absent) (guard (syntax-replacement-preserves-comments? replacement comments) #:else (log-resyntax-warning diff --git a/private/syntax-replacement.rkt b/private/syntax-replacement.rkt index a08c1ea..70b9dfd 100644 --- a/private/syntax-replacement.rkt +++ b/private/syntax-replacement.rkt @@ -16,7 +16,9 @@ [syntax-replacement-render (-> syntax-replacement? string-replacement?)] [syntax-replacement-original-syntax (-> syntax-replacement? (and/c syntax? syntax-original?))] [syntax-replacement-new-syntax (-> syntax-replacement? syntax?)] - [syntax-replacement-preserves-free-identifiers? (-> syntax-replacement? boolean?)] + [syntax-replacement-introduces-incorrect-bindings? (-> syntax-replacement? boolean?)] + [syntax-replacement-introduced-incorrect-identifiers + (-> syntax-replacement? (listof identifier?))] [syntax-replacement-preserves-comments? (-> syntax-replacement? range-set? boolean?)] [syntax-replacement-dropped-comment-locations (-> syntax-replacement? range-set? range-set?)])) @@ -179,16 +181,29 @@ (check-equal? (syntax-replacement-render replacement) expected)]))) -(define (syntax-replacement-preserves-free-identifiers? replacement) - (match replacement - [(syntax-replacement #:original-syntax orig - #:new-syntax new - #:introduction-scope intro) - (define ignore (list #'ORIGINAL-GAP)) - (for/and ([new-id (in-syntax-identifiers new)] - #:unless (member new-id ignore free-identifier=?) - #:unless (bound-identifier=? new-id (intro new-id 'remove))) - (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id))))])) +(define (syntax-replacement-introduces-incorrect-bindings? replacement) + (match-define (syntax-replacement #:original-syntax orig + #:new-syntax new + #:introduction-scope intro) + replacement) + (define ignore (list #'ORIGINAL-GAP)) + (for/and ([new-id (in-syntax-identifiers new)] + #:unless (member new-id ignore free-identifier=?) + #:unless (bound-identifier=? new-id (intro new-id 'remove))) + (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id))))) + + +(define (syntax-replacement-introduced-incorrect-identifiers replacement) + (match-define (syntax-replacement #:original-syntax orig + #:new-syntax new + #:introduction-scope intro) + replacement) + (define ignore (list #'ORIGINAL-GAP)) + (for/list ([new-id (in-syntax-identifiers new)] + #:unless (member new-id ignore free-identifier=?) + #:unless (bound-identifier=? new-id (intro new-id 'remove)) + #:unless (free-identifier=? new-id (datum->syntax orig (syntax->datum new-id)))) + new-id)) (define (syntax-replacement-dropped-comment-locations replacement all-comment-locations)