Add fuse-map-with-for refactoring rule

default-recommendations.rkt

@@ -31,6 +31,7 @@
                resyntax/default-recommendations/let-replacement/match-let-replacement
                resyntax/default-recommendations/list-shortcuts
                resyntax/default-recommendations/loops/for-loop-shortcuts
+               resyntax/default-recommendations/loops/fuse-map-with-for
                resyntax/default-recommendations/loops/list-loopification
                resyntax/default-recommendations/loops/named-let-loopification
                resyntax/default-recommendations/match-shortcuts
@@ -73,6 +74,7 @@
          resyntax/default-recommendations/let-replacement/match-let-replacement
          resyntax/default-recommendations/list-shortcuts
          resyntax/default-recommendations/loops/for-loop-shortcuts
+         resyntax/default-recommendations/loops/fuse-map-with-for
          resyntax/default-recommendations/loops/list-loopification
          resyntax/default-recommendations/loops/named-let-loopification
          resyntax/default-recommendations/match-shortcuts
@@ -104,6 +106,7 @@
             exception-suggestions
             file-io-suggestions
             for-loop-shortcuts
+            fuse-map-with-for
             function-definition-shortcuts
             function-shortcuts
             hash-shortcuts

default-recommendations/loops/fuse-map-with-for-test.rkt

@@ -0,0 +1,107 @@
+#lang resyntax/test
+
+
+require: resyntax/default-recommendations/loops/fuse-map-with-for fuse-map-with-for
+
+
+header:
+- #lang racket/base
+
+
+test: "map producing list for for* loop can be fused"
+--------------------
+(define (f xs g h)
+  (define ys (map (λ (x) (g x)) xs))
+  (for* ([y (in-list ys)]
+         [z (in-list (h y))])
+    (displayln z)))
+====================
+(define (f xs g h)
+  (for* ([x (in-list xs)]
+         [y (in-list (g x))]
+         [z (in-list (h y))])
+    (displayln z)))
+--------------------
+
+
+test: "map producing list for single-clause for* loop can be fused"
+--------------------
+(define (f xs g)
+  (define ys (map (λ (x) (g x)) xs))
+  (for* ([y (in-list ys)])
+    (displayln y)))
+====================
+(define (f xs g)
+  (for* ([x (in-list xs)]
+         [y (in-list (g x))])
+    (displayln y)))
+--------------------
+
+
+test: "map producing list for for loop can be fused"
+--------------------
+(define (f xs g)
+  (define ys (map (λ (x) (g x)) xs))
+  (for ([y (in-list ys)])
+    (displayln y)))
+====================
+(define (f xs g)
+  (for ([x (in-list xs)])
+    (define y (g x))
+    (displayln y)))
+--------------------
+
+
+no-change-test: "multi-clause for loop cannot be fused"
+--------------------
+(define (f xs zs)
+  (define ys (map (λ (x) (+ x 1)) xs))
+  (for ([y (in-list ys)]
+        [z (in-list zs)])
+    (displayln (list y z))))
+--------------------
+
+
+no-change-test: "map with short lambda but ys used elsewhere not refactorable"
+--------------------
+(define (f xs g h)
+  (define ys (map (λ (x) (g x)) xs))
+  (for* ([y (in-list ys)]
+         [z (in-list (h y))])
+    (displayln z))
+  (displayln ys))
+--------------------
+
+
+test: "map with lambda that has multiple body forms is refactorable"
+--------------------
+(define (f xs g)
+  (define ys (map (λ (x) (displayln x) (g x)) xs))
+  (for ([y (in-list ys)])
+    (displayln y)))
+====================
+(define (f xs g)
+  (for ([x (in-list xs)])
+    (displayln x)
+    (define y (g x))
+    (displayln y)))
+--------------------
+
+
+test: "map with long single-body lambda is refactorable"
+--------------------
+(define (f xs)
+  (define long-name 42)
+  (define ys
+    (map (λ (x)
+           (+ x long-name))
+         xs))
+  (for ([y (in-list ys)])
+    (displayln y)))
+====================
+(define (f xs)
+  (define long-name 42)
+  (for ([x (in-list xs)])
+    (define y (+ x long-name))
+    (displayln y)))
+--------------------

default-recommendations/loops/fuse-map-with-for.rkt

@@ -0,0 +1,111 @@
+#lang racket/base
+
+
+(require racket/contract/base)
+
+
+(provide
+ (contract-out
+  [fuse-map-with-for refactoring-suite?]))
+
+
+(require resyntax/base
+         racket/list
+         resyntax/default-recommendations/analyzers/identifier-usage
+         resyntax/default-recommendations/let-replacement/private/let-binding
+         resyntax/default-recommendations/private/lambda-by-any-name
+         syntax/parse)
+
+
+;@----------------------------------------------------------------------------------------------------
+
+
+;; A short lambda suitable for fusing with a for loop. For multi-body lambdas, we need to
+;; separate the prefix forms (all but last) from the result form (the last).
+(define-syntax-class fuseable-map-lambda
+  #:attributes (x single-body [multi-body 1] [prefix-forms 1] result-form)
+
+  ;; Lambdas with let expressions that can be refactored
+  (pattern
+    (_:lambda-by-any-name (x:id)
+                          original-body:body-with-refactorable-let-expression)
+    #:with (multi-body ...) #'(original-body.refactored ...)
+    #:do [(define refactored-forms (attribute original-body.refactored))
+          (define prefix-list (if (null? refactored-forms) '() (drop-right refactored-forms 1)))
+          (define result (if (null? refactored-forms) #'(begin) (last refactored-forms)))]
+    #:attr [prefix-forms 1] prefix-list
+    #:attr result-form result
+    #:attr single-body #'(begin original-body.refactored ...))
+
+  ;; Lambdas with multiple body forms (two or more)
+  (pattern (_:lambda-by-any-name (x:id) prefix-form ... last-form)
+    #:when (not (null? (attribute prefix-form)))
+    #:with (multi-body ...) #'(prefix-form ... last-form)
+    #:attr [prefix-forms 1] (attribute prefix-form)
+    #:attr result-form #'last-form
+    #:attr single-body #'(begin prefix-form ... last-form))
+
+  ;; Short lambdas with a single body form
+  (pattern (_:lambda-by-any-name (x:id) only-form)
+    #:with (multi-body ...) #'(only-form)
+    #:attr [prefix-forms 1] '()
+    #:attr result-form #'only-form
+    #:attr single-body #'only-form))
+
+
+(define-definition-context-refactoring-rule fuse-map-with-for*-rule
+  #:description
+  "A `map` expression producing a list for a `for*` loop can be fused with the loop."
+  #:analyzers (list identifier-usage-analyzer)
+  #:literals (define map in-list for*)
+  (~seq body-before ...
+        (define ys:id (map function:fuseable-map-lambda list-expr:expr))
+        (for*-id:for*
+         (~and original-clauses
+               ([y-var:id (in-list ys-usage:id)] remaining-clause ...))
+         for-body ...)
+        body-after ...)
+
+  ;; Check that ys is only used in the for loop, not elsewhere
+  #:when (free-identifier=? (attribute ys) (attribute ys-usage))
+  #:when (equal? (syntax-property #'ys 'usage-count) 1)
+
+  ;; Generate the refactored code - fuse as nested clauses
+  (body-before ...
+   (for*-id ([function.x (in-list list-expr)]
+             [y-var (in-list function.single-body)]
+             remaining-clause ...)
+            for-body ...)
+   body-after ...))
+
+
+;; Rule for when there are single-clause for loops (not for*) - use internal definition
+(define-definition-context-refactoring-rule fuse-map-with-for-single-clause-rule
+  #:description
+  "A `map` expression producing a list for a single-clause `for` loop can be fused with the loop."
+  #:analyzers (list identifier-usage-analyzer)
+  #:literals (define map in-list for)
+  (~seq body-before ...
+        (define ys:id (map function:fuseable-map-lambda list-expr:expr))
+        (for-id:for
+         (~and original-clauses
+               ([y-var:id (in-list ys-usage:id)]))
+         for-body ...)
+        body-after ...)
+
+  ;; Check that ys is only used in the for loop, not elsewhere
+  #:when (free-identifier=? (attribute ys) (attribute ys-usage))
+  #:when (equal? (syntax-property #'ys 'usage-count) 1)
+
+  ;; Generate the refactored code - use internal definition
+  (body-before ...
+   (for-id ([function.x (in-list list-expr)])
+           function.prefix-forms ...
+           (define y-var function.result-form)
+           for-body ...)
+   body-after ...))
+
+
+(define-refactoring-suite fuse-map-with-for
+  #:rules (fuse-map-with-for*-rule
+           fuse-map-with-for-single-clause-rule))