Reorganize core modules (#302)

Closes #296.
jackfirth · Sep 18, 2024 · 0b33a69 · 0b33a69
1 parent d32e9da
commit 0b33a69
Show file tree

Hide file tree

Showing 32 changed files with 123 additions and 172 deletions.
diff --git a/refactoring-rule.rkt → base.rkt b/refactoring-rule.rkt → base.rkt
@@ -5,11 +5,21 @@
 
 
 (provide
+ ~replacement
+ ~splicing-replacement
+ ~focus-replacement-on
+ define-refactoring-suite
  define-refactoring-rule
  define-definition-context-refactoring-rule
  (contract-out
   [refactoring-rule? predicate/c]
-  [refactoring-rule-description (-> refactoring-rule? immutable-string?)]))
+  [refactoring-rule-description (-> refactoring-rule? immutable-string?)]
+  [refactoring-suite? predicate/c]
+  [refactoring-suite
+   (->* ()
+        (#:rules (sequence/c refactoring-rule?) #:name (or/c interned-symbol? #false))
+        refactoring-suite?)]
+  [refactoring-suite-rules (-> refactoring-suite? (listof refactoring-rule?))]))
 
 
 (module+ private
@@ -22,20 +32,70 @@
 (require (for-syntax racket/base
                      racket/syntax
                      resyntax/private/more-syntax-parse-classes)
+         racket/sequence
          rebellion/base/immutable-string
          rebellion/base/option
+         rebellion/base/symbol
          rebellion/type/object
          resyntax/default-recommendations/private/definition-context
          resyntax/private/source
          resyntax/private/syntax-replacement
          resyntax/private/syntax-neighbors
          syntax/parse
+         syntax/parse/experimental/template
          syntax/parse/define)
 
 
 ;@----------------------------------------------------------------------------------------------------
 
 
+(define-template-metafunction (~replacement stx)
+  (syntax-parse stx
+    [(_ new-stx #:original orig-syntax)
+     (syntax-property #'new-stx 'replacement-for #'orig-syntax)]
+    [(_ new-stx #:original-splice (first-orig orig-syntax ... last-orig))
+     (syntax-property (syntax-property #'new-stx 'head-replacement-for #'first-orig)
+                      'tail-replacement-for #'last-orig)]
+    [(_ new-stx #:original-splice (only-orig-syntax))
+     (syntax-property (syntax-property #'new-stx 'head-replacement-for #'only-orig-syntax)
+                      'tail-replacement-for #'only-orig-syntax)]))
+
+
+(define-template-metafunction (~splicing-replacement stx)
+  (syntax-parse stx
+    [(_ (~and new-stx (first-subform subform ... last-subform)) #:original orig-syntax)
+     (define first-with-prop (syntax-property #'first-subform 'head-replacement-for #'orig-syntax))
+     (define last-with-prop (syntax-property #'last-subform 'tail-replacement-for #'orig-syntax))
+     (define new-stx-with-subform-props
+       (datum->syntax #'new-stx
+                      #`(#,first-with-prop subform ... #,last-with-prop)
+                      #'new-stx
+                      #'new-stx))
+     (syntax-property new-stx-with-subform-props 'replacement-for #'orig-syntax)]
+    [(_ (~and new-stx (only-subform)) #:original orig-syntax)
+     (define subform-with-props
+       (syntax-property (syntax-property #'only-subform 'head-replacement-for #'orig-syntax)
+                        'tail-replacement-for
+                        #'orig-syntax))
+     (define new-stx-with-subform-props
+       (datum->syntax #'new-stx #`(#,subform-with-props) #'new-stx #'new-stx))
+     (syntax-property new-stx-with-subform-props 'replacement-for #'orig-syntax)]
+    [(_ (~and new-stx ()) #:original orig-syntax)
+     (syntax-property #'new-stx 'replacement-for #'orig-syntax)]))
+
+
+(define-template-metafunction (~focus-replacement-on stx)
+  (syntax-parse stx
+    [(_ (~and new-stx (substx ...)))
+     #:cut
+     (define substxs-with-prop
+       (for/list ([sub (in-list (attribute substx))])
+         (syntax-property sub 'focus-replacement-on #true)))
+     (syntax-property (datum->syntax #'new-stx substxs-with-prop #'new-stx #'new-stx)
+                      'focus-replacement-on #true)]
+    [(_ new-stx) (syntax-property #'new-stx 'focus-replacement-on #true)]))
+
+
 (define-object-type refactoring-rule (transformer description)
   #:omit-root-binding
   #:constructor-name constructor:refactoring-rule)
@@ -128,3 +188,36 @@
       #:description description
       (~var expression expression-matching-id)
       expression.refactored)))
+
+
+(define-object-type refactoring-suite (rules)
+  #:constructor-name constructor:refactoring-suite
+  #:omit-root-binding)
+
+
+(define (refactoring-suite #:rules [rules '()] #:name [name #false])
+  (constructor:refactoring-suite #:rules (sequence->list rules) #:name name))
+
+
+(begin-for-syntax
+
+  (define-splicing-syntax-class rules-list
+    #:attributes (as-list-expr)
+    (pattern (~seq) #:with as-list-expr #'(list))
+    (pattern (~seq #:rules ~! (rule ...))
+      #:declare rule (expr/c #'refactoring-rule?)
+      #:with as-list-expr #'(list rule.c ...)))
+
+  (define-splicing-syntax-class suites-list
+    #:attributes (as-list-expr)
+    (pattern (~seq) #:with as-list-expr #'(list))
+    (pattern (~seq #:suites ~! (suite ...))
+      #:declare suite (expr/c #'refactoring-suite?)
+      #:with as-list-expr #'(append (refactoring-suite-rules suite.c) ...))))
+
+
+(define-syntax-parse-rule (define-refactoring-suite id:id rules:rules-list suites:suites-list)
+  (define id
+    (refactoring-suite
+     #:name 'id
+     #:rules (append rules.as-list-expr suites.as-list-expr))))
diff --git a/default-recommendations.rkt b/default-recommendations.rkt
@@ -56,7 +56,7 @@
          resyntax/default-recommendations/syntax-shortcuts
          resyntax/default-recommendations/syntax-parse-shortcuts
          resyntax/default-recommendations/syntax-rules-shortcuts
-         resyntax/refactoring-suite)
+         resyntax/base)
 
 
 ;@----------------------------------------------------------------------------------------------------

diff --git a/default-recommendations/boolean-shortcuts.rkt b/default-recommendations/boolean-shortcuts.rkt
@@ -14,10 +14,7 @@
          resyntax/default-recommendations/private/boolean
          resyntax/default-recommendations/private/syntax-lines
          resyntax/default-recommendations/private/syntax-tree
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
-         resyntax/private/syntax-neighbors
-         resyntax/private/syntax-replacement
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/comparison-shortcuts.rkt b/default-recommendations/comparison-shortcuts.rkt
@@ -11,8 +11,7 @@
 
 (require (for-syntax racket/base)
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/conditional-shortcuts.rkt b/default-recommendations/conditional-shortcuts.rkt
@@ -10,18 +10,11 @@
 
 
 (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
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
-         resyntax/private/syntax-neighbors
-         resyntax/private/syntax-replacement
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/contract-shortcuts.rkt b/default-recommendations/contract-shortcuts.rkt
@@ -14,8 +14,7 @@
          resyntax/default-recommendations/private/syntax-lines
          resyntax/default-recommendations/private/syntax-tree
          resyntax/private/syntax-replacement
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/definition-shortcuts.rkt b/default-recommendations/definition-shortcuts.rkt
@@ -11,8 +11,7 @@
 
 (require (for-syntax racket/base)
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/file-io-suggestions.rkt b/default-recommendations/file-io-suggestions.rkt
@@ -12,8 +12,7 @@
 (require racket/file
          racket/list
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/for-loop-shortcuts.rkt b/default-recommendations/for-loop-shortcuts.rkt
@@ -13,8 +13,7 @@
          racket/list
          racket/set
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/default-recommendations/private/boolean
          resyntax/default-recommendations/private/lambda-by-any-name
          resyntax/default-recommendations/private/let-binding

diff --git a/default-recommendations/function-definition-shortcuts.rkt b/default-recommendations/function-definition-shortcuts.rkt
@@ -15,8 +15,7 @@
          rebellion/private/static-name
          resyntax/default-recommendations/private/lambda-by-any-name
          resyntax/default-recommendations/private/syntax-lines
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          syntax/parse)
 

diff --git a/default-recommendations/function-shortcuts.rkt b/default-recommendations/function-shortcuts.rkt
@@ -12,8 +12,7 @@
 (require (for-syntax racket/base)
          rebellion/private/static-name
          resyntax/default-recommendations/private/literal-constant
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          syntax/parse)
 

diff --git a/default-recommendations/gap-preservation.rkt b/default-recommendations/gap-preservation.rkt
@@ -16,8 +16,7 @@
 
 
 (require rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors)
 
 

diff --git a/default-recommendations/hash-shortcuts.rkt b/default-recommendations/hash-shortcuts.rkt
@@ -17,8 +17,7 @@
          resyntax/default-recommendations/private/pure-expression
          resyntax/default-recommendations/private/syntax-equivalence
          resyntax/default-recommendations/private/syntax-identifier-sets
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors
          syntax/parse)
 

diff --git a/default-recommendations/legacy-contract-migrations.rkt b/default-recommendations/legacy-contract-migrations.rkt
@@ -12,8 +12,7 @@
 (require (for-syntax racket/base)
          racket/syntax
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite)
+         resyntax/base)
 
 
 ;@----------------------------------------------------------------------------------------------------

diff --git a/default-recommendations/legacy-struct-migrations.rkt b/default-recommendations/legacy-struct-migrations.rkt
@@ -12,8 +12,7 @@
 (require (for-syntax racket/base)
          racket/syntax
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          syntax/parse)
 

diff --git a/default-recommendations/legacy-syntax-migrations.rkt b/default-recommendations/legacy-syntax-migrations.rkt
@@ -15,8 +15,7 @@
                        racket/require-syntax
                        syntax/parse)
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors
          resyntax/private/syntax-replacement
          syntax/parse)

diff --git a/default-recommendations/let-binding-suggestions.rkt b/default-recommendations/let-binding-suggestions.rkt
@@ -28,8 +28,7 @@
          resyntax/default-recommendations/private/let-binding
          resyntax/default-recommendations/private/syntax-equivalence
          resyntax/default-recommendations/private/syntax-identifier-sets
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          resyntax/private/syntax-neighbors
          syntax/id-set

diff --git a/default-recommendations/list-shortcuts.rkt b/default-recommendations/list-shortcuts.rkt
@@ -17,8 +17,7 @@
          resyntax/default-recommendations/private/literal-constant
          resyntax/default-recommendations/private/syntax-identifier-sets
          resyntax/private/syntax-neighbors
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/match-shortcuts.rkt b/default-recommendations/match-shortcuts.rkt
@@ -17,8 +17,7 @@
          resyntax/default-recommendations/private/syntax-lines
          resyntax/default-recommendations/private/syntax-tree
          resyntax/default-recommendations/private/syntax-identifier-sets
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors
          syntax/parse)
 

diff --git a/default-recommendations/miscellaneous-suggestions.rkt b/default-recommendations/miscellaneous-suggestions.rkt
@@ -12,8 +12,7 @@
 (require (for-syntax racket/base)
          racket/match
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          syntax/parse)
 

diff --git a/default-recommendations/numeric-shortcuts.rkt b/default-recommendations/numeric-shortcuts.rkt
@@ -11,8 +11,7 @@
 
 (require rebellion/private/static-name
          resyntax/default-recommendations/private/lambda-by-any-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/private/let-binding.rkt b/default-recommendations/private/let-binding.rkt
@@ -14,9 +14,9 @@
 
 (require racket/list
          racket/match
+         resyntax/base
          resyntax/default-recommendations/private/syntax-identifier-sets
          resyntax/default-recommendations/private/lambda-by-any-name
-         resyntax/private/syntax-neighbors
          resyntax/private/logger
          syntax/id-set
          syntax/parse

diff --git a/default-recommendations/require-and-provide-suggestions.rkt b/default-recommendations/require-and-provide-suggestions.rkt
@@ -20,8 +20,7 @@
          rebellion/private/static-name
          rebellion/streaming/transducer
          resyntax/private/logger
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          syntax/parse)
 
 

diff --git a/default-recommendations/string-shortcuts.rkt b/default-recommendations/string-shortcuts.rkt
@@ -13,8 +13,7 @@
          racket/set
          racket/string
          rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors
          syntax/parse)
 

diff --git a/default-recommendations/syntax-parse-shortcuts.rkt b/default-recommendations/syntax-parse-shortcuts.rkt
@@ -10,8 +10,7 @@
 
 
 (require rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-neighbors
          resyntax/private/syntax-replacement
          syntax/parse

diff --git a/default-recommendations/syntax-rules-shortcuts.rkt b/default-recommendations/syntax-rules-shortcuts.rkt
@@ -10,8 +10,7 @@
 
 
 (require rebellion/private/static-name
-         resyntax/refactoring-rule
-         resyntax/refactoring-suite
+         resyntax/base
          resyntax/private/syntax-replacement
          syntax/parse)