Add ~replacement metafunction

This cooperates with `syntax-mark-original-neighbors` and `syntax-originally-neighbors?` to detect when two syntax objects weren't originally adjacent in the input syntax, but one (or both) of them is a drop-in replacements for input subforms that _were_ adjacent. This makes a lot of uses of `ORIGINAL-GAP` unnecessary, though sadly not all of them.

default-recommendations/boolean-shortcuts-test.rkt

@@ -109,6 +109,24 @@ test: "when not can be refactored to use unless"
 ------------------------------
 
 
+test: "refactoring negated when into unless preserves comments"
+------------------------------
+; comment before
+(when
+    ; strangely positioned comment before
+    (not 'foo)
+  ; comment after
+  (displayln "not foo"))
+------------------------------
+------------------------------
+; comment before
+; strangely positioned comment before
+(unless 'foo
+  ; comment after
+  (displayln "not foo"))
+------------------------------
+
+
 test: "unless not can be refactored to use when"
 ------------------------------
 (unless (not 'foo)
@@ -118,3 +136,21 @@ test: "unless not can be refactored to use when"
 (when 'foo
   (displayln "foo"))
 ------------------------------
+
+
+test: "refactoring negated unless into when preserves comments"
+------------------------------
+; comment before
+(unless
+    ; strangely positioned comment before
+    (not 'foo)
+  ; comment after
+  (displayln "foo"))
+------------------------------
+------------------------------
+; comment before
+; strangely positioned comment before
+(when 'foo
+  ; comment after
+  (displayln "foo"))
+------------------------------

default-recommendations/boolean-shortcuts.rkt

@@ -16,6 +16,7 @@
          resyntax/default-recommendations/private/syntax-tree
          resyntax/refactoring-rule
          resyntax/refactoring-suite
+         resyntax/private/syntax-neighbors
          resyntax/private/syntax-replacement
          syntax/parse)
 
@@ -67,18 +68,25 @@
    (and condition then)])
 
 
+(define-syntax-class negated-condition
+  #:attributes (flipped)
+  #:literals (not)
+  (pattern (not base-condition:expr)
+    #:with flipped #`(~replacement base-condition #:original #,this-syntax)))
+
+
 (define-refactoring-rule inverted-when
-  #:description "This negated when expression can be replaced by an unless expression."
-  #:literals (when not)
-  [(when (~and negated (not condition)) body0 body ...)
-   (unless condition (ORIGINAL-GAP negated body0) body0 body ...)])
+  #:description "This negated `when` expression can be replaced by an `unless` expression."
+  #:literals (when)
+  [(when-id:when negated:negated-condition body ...)
+   ((~replacement unless #:original when-id) negated.flipped body ...)])
 
 
 (define-refactoring-rule inverted-unless
   #:description "This negated `unless` expression can be replaced by a `when` expression."
-  #:literals (unless not)
-  [(unless (~and negated (not condition)) body0 body ...)
-   (when condition (ORIGINAL-GAP negated body0) body0 body ...)])
+  #:literals (unless)
+  [(unless-id:unless negated:negated-condition body ...)
+   ((~replacement when #:original unless-id) negated.flipped body ...)])
 
 
 (define boolean-shortcuts

default-recommendations/conditional-shortcuts.rkt

@@ -20,6 +20,7 @@
          resyntax/default-recommendations/private/syntax-lines
          resyntax/refactoring-rule
          resyntax/refactoring-suite
+         resyntax/private/syntax-neighbors
          resyntax/private/syntax-replacement
          syntax/parse)
 
@@ -130,15 +131,16 @@
     clause ... last-non-else-clause
     (~and outer-else-clause [else (cond nested-clause ...)]))
    (outer-cond-id clause ... last-non-else-clause
-    (ORIGINAL-GAP last-non-else-clause outer-else-clause)
-    nested-clause ...)])
+                  (ORIGINAL-GAP last-non-else-clause outer-else-clause)
+                  nested-clause ...)])
 
 
 (define-syntax-class let-refactorable-cond-clause
-  #:attributes ([refactored 0])
+  #:attributes (refactored)
   (pattern
-    [condition:expr let-expr:body-with-refactorable-let-expression]
-    #:with refactored #'[condition let-expr.refactored ...]))
+    (~and clause [condition:expr let-expr:body-with-refactorable-let-expression])
+    #:with refactored
+    #'(~replacement [condition let-expr.refactored ...] #:original clause)))
 
 
 (define (first-syntax stx)
@@ -155,20 +157,8 @@
   #:description
   "Internal definitions are recommended instead of `let` expressions, to reduce nesting."
   #:literals (cond)
-  [((~and outer-cond-id cond)
-    clause-before ...
-    clause:let-refactorable-cond-clause
-    clause-after ...)
-   #:with form-before (or (last-syntax #'(clause-before ...)) #'outer-cond-id)
-   #:with (after ...)
-   (let ([form-after (first-syntax #'(clause-after ...))])
-     (if form-after
-         #`((ORIGINAL-GAP clause #,form-after) clause-after ...)
-         (list)))
-   (outer-cond-id clause-before ...
-    (ORIGINAL-GAP form-before clause)
-    clause.refactored
-    after ...)])
+  [(cond-id:cond clause-before ... clause:let-refactorable-cond-clause clause-after ...)
+   (cond-id clause-before ... clause.refactored clause-after ...)])
 
 
 (define-syntax-class if-arm
@@ -202,9 +192,7 @@
    (if (attribute else-expr.uses-begin?)
        #'([else (ORIGINAL-GAP then-expr else-expr) else-expr.refactored ...])
        #'((ORIGINAL-GAP then-expr else-expr) [else else-expr.refactored ...]))
-   (cond
-     true-branch ...
-     false-branch ...)])
+   (cond true-branch ... false-branch ...)])
 
 
 (define-refactoring-rule if-let-to-cond

default-recommendations/for-loop-shortcuts.rkt

@@ -21,7 +21,7 @@
          resyntax/default-recommendations/private/metafunction
          resyntax/default-recommendations/private/syntax-identifier-sets
          resyntax/default-recommendations/private/syntax-lines
-         resyntax/private/syntax-replacement
+         resyntax/private/syntax-neighbors
          syntax/parse)
 
 
@@ -61,9 +61,9 @@
   #:attributes (flat? [leading-clause 1] trailing-expression)
 
   (pattern
-      (append-map
-       (_:lambda-by-any-name (y:id) append-map-body:sequence-syntax-convertible-list-expression)
-       list-expression:sequence-syntax-convertible-list-expression)
+    (append-map
+     (_:lambda-by-any-name (y:id) append-map-body:sequence-syntax-convertible-list-expression)
+     list-expression:sequence-syntax-convertible-list-expression)
     #:with flat? #false
     #:with (leading-clause ...) #'([y list-expression.refactored])
     #:with trailing-expression #'append-map-body.refactored)
@@ -79,31 +79,31 @@
   #:literals (map filter append-map)
 
   (pattern
-      (map
-       (_:lambda-by-any-name (x:id) loop-body:expr ...+)
-       (filter
-        (_:lambda-by-any-name (y:id) filter-body:expr)
-        list-expression:sequence-syntax-convertible-list-expression))
+    (map
+     (_:lambda-by-any-name (x:id) loop-body:expr ...+)
+     (filter
+      (_:lambda-by-any-name (y:id) filter-body:expr)
+      list-expression:sequence-syntax-convertible-list-expression))
     #:when (bound-identifier=? #'x #'y)
     #:with nesting-loop? #false
     #:with loop-clauses #'([x list-expression.refactored] #:when filter-body)
     #:with loop #'(for/list loop-clauses loop-body ...))
 
   (pattern
-      (map
-       (_:lambda-by-any-name (x:id) loop-body:expr ...+)
-       (append-map
-        (_:lambda-by-any-name (y:id) append-map-body:sequence-syntax-convertible-list-expression)
-        list-expression:sequence-syntax-convertible-list-expression))
+    (map
+     (_:lambda-by-any-name (x:id) loop-body:expr ...+)
+     (append-map
+      (_:lambda-by-any-name (y:id) append-map-body:sequence-syntax-convertible-list-expression)
+      list-expression:sequence-syntax-convertible-list-expression))
     #:when (not (bound-identifier=? #'x #'y))
     #:with nesting-loop? #true
     #:with loop-clauses #'([y list-expression.refactored] [x append-map-body.refactored])
     #:with loop #'(for*/list loop-clauses loop-body ...))
 
   (pattern
-      (map
-       (_:lambda-by-any-name (x:id) loop-body:expr ...+)
-       list-expression:sequence-syntax-convertible-list-expression)
+    (map
+     (_:lambda-by-any-name (x:id) loop-body:expr ...+)
+     list-expression:sequence-syntax-convertible-list-expression)
     #:with nesting-loop? #false
     #:with loop-clauses #'([x list-expression.refactored])
     #:with loop #'(for/list loop-clauses loop-body ...)))
@@ -180,23 +180,23 @@
   #:description "`for` loops can build vectors directly."
   #:literals (list->vector)
   [(list->vector (loop-id:for-list-id clauses body ...))
-   (loop-id.vector-id (ORIGINAL-GAP loop-id clauses) clauses body ...)])
+   ((~replacement loop-id.vector-id #:original loop-id) clauses body ...)])
 
 
 (define-refactoring-rule list->set-to-for/set
   #:description "`for` loops can build sets directly"
   #:literals (list->set)
   [(list->set (loop-id:for-list-id clauses body ...))
-   (loop-id.set-id (ORIGINAL-GAP loop-id clauses) clauses body ...)])
+   ((~replacement loop-id.set-id #:original loop-id) clauses body ...)])
 
 
 (define-refactoring-rule for/fold-building-hash-to-for/hash
   #:description "This `for` loop is building a hash and can be simplified."
   #:literals (for/fold for*/fold hash make-immutable-hash)
   [((~or (~and for/fold (~bind [loop #'for/hash])) (~and for*/fold (~bind [loop #'for*/hash])))
     ([h:id (~or (hash) (make-immutable-hash))]) iteration-clauses
-     body ...
-     (hash-set h-usage:id key value))
+    body ...
+    (hash-set h-usage:id key value))
    #:when (free-identifier=? #'h #'h-usage)
    #:when (not (set-member? (syntax-free-identifiers #'(body ...)) #'h))
    (loop iteration-clauses body ... (values key value))])
@@ -247,10 +247,11 @@
   [((~and loop-id (~or for/and for*/and))
     (~and original-clauses (clause ...))
     (~and original-body (or condition:condition-expression ...+ last-condition)))
-   (loop-id (ORIGINAL-GAP loop-id original-clauses)
-            (clause ... (~@ (~if condition.negated? #:when #:unless) condition.base-condition) ...)
-            (ORIGINAL-GAP original-clauses original-body)
-            last-condition)])
+   (loop-id
+    (~replacement
+     (clause ... (~@ (~if condition.negated? #:when #:unless) condition.base-condition) ...)
+     #:original original-clauses)
+    (~replacement last-condition #:original original-body))])
 
 
 (define-syntax-class apply-append-refactorable-for-loop

default-recommendations/gap-preservation-test.rkt

@@ -65,3 +65,70 @@ test: "comments preserved in splice when form inserted at end"
      c
      "foo"))
 -----------------------------------
+
+
+test: "comments preserved in splice when first form replaced"
+-----------------------------------
+(define (code replace-first-with-foo a b c)
+  (replace-first-with-foo a
+                          ; buggy comment after (sorawee/fmt#68)
+                          b
+                          c))
+-----------------------------------
+-----------------------------------
+(define (code replace-first-with-foo a b c)
+  ; buggy comment after (sorawee/fmt#68)
+("foo" b c))
+-----------------------------------
+
+
+test: "comments preserved in splice when second form replaced"
+-----------------------------------
+(define (code replace-second-with-foo a b c)
+  (replace-second-with-foo a
+                           ; buggy comment before (sorawee/fmt#68)
+                           b
+                           ; comment after
+                           c))
+-----------------------------------
+-----------------------------------
+(define (code replace-second-with-foo a b c)
+  ; buggy comment before (sorawee/fmt#68)
+(a "foo"
+   ; comment after
+   c))
+-----------------------------------
+
+
+test: "comments preserved in splice when last form replaced"
+-----------------------------------
+(define (code replace-last-with-foo a b c)
+  (replace-last-with-foo a
+                         b
+                         ; comment before
+                         c))
+-----------------------------------
+-----------------------------------
+(define (code replace-last-with-foo a b c)
+  (a b
+     ; comment before
+     "foo"))
+-----------------------------------
+
+
+test: "comments preserved in splice when first and last forms replaced"
+-----------------------------------
+(define (code replace-first-and-last-with-foo a b c)
+  (replace-first-and-last-with-foo a
+                                   ; buggy comment after (sorawee/fmt#68)
+                                   b
+                                   ; comment before
+                                   c))
+-----------------------------------
+-----------------------------------
+(define (code replace-first-and-last-with-foo a b c)
+  ; buggy comment after (sorawee/fmt#68)
+("foo" b
+       ; comment before
+       "foo"))
+-----------------------------------

default-recommendations/gap-preservation.rkt

@@ -15,19 +15,10 @@
   [gap-preservation-rules refactoring-suite?]))
 
 
-(require (for-syntax racket/base)
-         racket/list
-         rebellion/private/static-name
-         resyntax/default-recommendations/private/boolean
-         resyntax/default-recommendations/private/definition-context
-         resyntax/default-recommendations/private/exception
-         resyntax/default-recommendations/private/let-binding
-         resyntax/default-recommendations/private/metafunction
-         resyntax/default-recommendations/private/syntax-lines
+(require rebellion/private/static-name
          resyntax/refactoring-rule
          resyntax/refactoring-suite
-         resyntax/private/syntax-replacement
-         syntax/parse)
+         resyntax/private/syntax-neighbors)
 
 
 ;@----------------------------------------------------------------------------------------------------
@@ -57,11 +48,40 @@
   [(insert-foo-first-and-last a ...) ("foo" a ... "foo")])
 
 
+(define-refactoring-rule suggest-replacing-first-with-foo
+  #:description "This refactoring rule is for testing Resyntax, ignore its suggestions."
+  #:datum-literals (replace-first-with-foo)
+  [(replace-first-with-foo old a ...) ((~replacement "foo" #:original old) a ...)])
+
+
+(define-refactoring-rule suggest-replacing-second-with-foo
+  #:description "This refactoring rule is for testing Resyntax, ignore its suggestions."
+  #:datum-literals (replace-second-with-foo)
+  [(replace-second-with-foo a0 old a ...) (a0 (~replacement "foo" #:original old) a ...)])
+
+
+(define-refactoring-rule suggest-replacing-last-with-foo
+  #:description "This refactoring rule is for testing Resyntax, ignore its suggestions."
+  #:datum-literals (replace-last-with-foo)
+  [(replace-last-with-foo a ... old) (a ... (~replacement "foo" #:original old))])
+
+
+(define-refactoring-rule suggest-replacing-first-and-last-with-foo
+  #:description "This refactoring rule is for testing Resyntax, ignore its suggestions."
+  #:datum-literals (replace-first-and-last-with-foo)
+  [(replace-first-and-last-with-foo old1 a ... old2)
+   ((~replacement "foo" #:original old1) a ... (~replacement "foo" #:original old2))])
+
+
 (define gap-preservation-rules
   (refactoring-suite
    #:name (name gap-preservation-rules)
    #:rules
    (list suggest-inserting-foo-first
          suggest-inserting-foo-second
          suggest-inserting-foo-last
-         suggest-inserting-foo-first-and-last)))
+         suggest-inserting-foo-first-and-last
+         suggest-replacing-first-with-foo
+         suggest-replacing-second-with-foo
+         suggest-replacing-last-with-foo
+         suggest-replacing-first-and-last-with-foo)))