├── private ├── commit.rkt ├── identifier-naming.rkt ├── syntax-range.rkt ├── logger.rkt ├── string-indent.rkt ├── analyzer.rkt ├── scribble-evaluator-factory.rkt ├── run-command.rkt ├── more-syntax-parse-classes.rkt ├── git.rkt ├── limiting.rkt ├── syntax-movement.rkt └── code-snippet.rkt ├── test ├── info.rkt ├── explicit-require-no-auto-test.rkt ├── private │ ├── statement.rkt │ └── grammar.rkt ├── automatic-default-recommendations-test.rkt ├── analyzer-timeout-test.rkt └── testing-lang-test.rkt ├── GITHUB_APP_PRIVACY_POLICY.md ├── .gitignore ├── default-recommendations ├── file-io-suggestions-test.rkt ├── file-io-suggestions.rkt ├── private │ ├── literal-constant.rkt │ ├── lambda-by-any-name.rkt │ ├── list-function.rkt │ ├── if-arm.rkt │ ├── metafunction.rkt │ ├── syntax-identifier-sets.rkt │ ├── exception.rkt │ ├── syntax-lines.rkt │ ├── syntax-equivalence.rkt │ ├── syntax-tree.rkt │ └── pure-expression.rkt ├── analyzers │ ├── function-expression-analyzer-test.rkt │ ├── function-expression-analyzer.rkt │ ├── ignored-result-values-test.rkt │ ├── variable-mutability.rkt │ ├── ignored-result-values.rkt │ └── variable-mutability-test.rkt ├── one-line-reformatting-test.rkt ├── syntax-rules-shortcuts-test.rkt ├── function-shortcuts-test.rkt ├── syntax-rules-shortcuts.rkt ├── legacy │ ├── provide-contract-migration-test.rkt │ ├── provide-contract-migration.rkt │ ├── make-temporary-directory-migration-test.rkt │ ├── legacy-struct-migrations.rkt │ ├── define-simple-macro-migration.rkt │ ├── make-temporary-directory-migration.rkt │ ├── define-simple-macro-migration-test.rkt │ ├── legacy-contract-migrations-test.rkt │ ├── legacy-contract-migrations.rkt │ ├── legacy-syntax-migrations-test.rkt │ ├── legacy-struct-migrations-test.rkt │ └── legacy-syntax-migrations.rkt ├── console-io-suggestions-test.rkt ├── windows-newline-test.rkt ├── let-binding-suggestions-test.rkt ├── unused-binding-suggestions.rkt ├── let-replacement │ ├── let-replacement-nesting-test.rkt │ ├── let-replacement-function-test.rkt │ ├── let-replacement-comment-test.rkt │ ├── cond-let-replacement.rkt │ ├── match-let-replacement.rkt │ ├── argument-let-replacement-test.rkt │ ├── argument-let-replacement.rkt │ ├── let-replacement.rkt │ └── match-let-replacement-test.rkt ├── numeric-shortcuts-test.rkt ├── class-shortcuts-test.rkt ├── unused-binding-suggestions-test.rkt ├── console-io-suggestions.rkt ├── let-binding-suggestions.rkt ├── comparison-shortcuts-test.rkt ├── syntax-shortcuts-test.rkt ├── dict-suggestions.rkt ├── mutability-predicates-test.rkt ├── class-shortcuts.rkt ├── function-shortcuts.rkt ├── loops │ └── private │ │ └── syntax-classes.rkt ├── contract-shortcuts.rkt ├── comment-preservation-test.rkt ├── syntax-parse-shortcuts.rkt ├── syntax-parse-shortcuts-test.rkt ├── numeric-shortcuts.rkt ├── dict-suggestions-test.rkt ├── exception-suggestions.rkt ├── contract-shortcuts-test.rkt ├── syntax-shortcuts.rkt ├── boolean-shortcuts.rkt ├── gap-preservation.rkt ├── mutability-predicates.rkt ├── gap-preservation-test.rkt ├── boolean-shortcuts-test.rkt └── comparison-shortcuts.rkt ├── CONTRIBUTING.md ├── .github ├── workflows │ ├── autopilot.yml │ ├── copilot-setup-steps.yml │ ├── ci.yml │ ├── resyntax-analyze.yml │ └── resyntax-submit-review.yml ├── ISSUE_TEMPLATE │ ├── unwanted-suggestion-report.yaml │ └── new-rule-request.yaml └── copilot-instructions.md ├── info.rkt └── README.md /private/commit.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide (struct-out resyntax-commit)) 5 | 6 | 7 | 8 | (struct resyntax-commit (message changes) #:transparent) -------------------------------------------------------------------------------- /test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | 4 | ; This test file causes Cover to hang for some reason, likely related to logging. 5 | (define cover-omit-paths 6 | (list "testing-lang-test.rkt")) 7 | -------------------------------------------------------------------------------- /test/explicit-require-no-auto-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | require: resyntax/default-recommendations list-shortcuts 4 | 5 | no-change-test: "explicit require should not get automatic default-recommendations" 6 | - (and (and 1 2) 3) 7 | -------------------------------------------------------------------------------- /test/private/statement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide (struct-out statement-transformer)) 5 | 6 | 7 | ;@---------------------------------------------------------------------------------------------------- 8 | 9 | 10 | (struct statement-transformer (procedure)) 11 | -------------------------------------------------------------------------------- /test/automatic-default-recommendations-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | header: 5 | - #lang racket/base 6 | 7 | 8 | test: "automatic default-recommendations: nested and should be flattened" 9 | - (and (and 1 2) 3) 10 | - (and 1 2 3) 11 | 12 | 13 | test: "automatic default-recommendations: nested or should be flattened" 14 | - (or (or 1 2) 3) 15 | - (or 1 2 3) 16 | 17 | -------------------------------------------------------------------------------- /GITHUB_APP_PRIVACY_POLICY.md: -------------------------------------------------------------------------------- 1 | # Privacy Policy 2 | 3 | Last updated: October 12, 2024 4 | 5 | The Resyntax CI GitHub App does not collect, use, store, or transmit any personal data. 6 | 7 | ## Contact Us 8 | 9 | If you have any questions about this Privacy Policy, you can contact us: 10 | 11 | - By email: jackhfirth@gmail.com 12 | - By visiting this page on our website: https://github.com/jackfirth/resyntax/ 13 | -------------------------------------------------------------------------------- /test/analyzer-timeout-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | header: 5 | ------------------------------ 6 | #lang racket/base 7 | ------------------------------ 8 | 9 | 10 | test: "timeout parameter can be customized in tests" 11 | @analyzer-timeout-millis 5000 12 | - (or 1 (or 2 3)) 13 | - (or 1 2 3) 14 | 15 | 16 | no-change-test: "timeout parameter works with no-change-test" 17 | @analyzer-timeout-millis 5000 18 | - (define x 42) 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | compiled/ 2 | doc/ 3 | *~ 4 | *.backup 5 | coverage/ 6 | # These only come up if you generate the scribble docs manually, instead of 7 | # through `raco setup`. But we exclude them anyway to help newcomers (and 8 | # Copilot) avoid accidentally committing rendered documentation files. 9 | main.html 10 | manual-fonts.css 11 | manual-racket.css 12 | manual-racket.js 13 | manual-style.css 14 | racket.css 15 | scribble-common.js 16 | scribble.css 17 | -------------------------------------------------------------------------------- /default-recommendations/file-io-suggestions-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations file-io-suggestions 5 | 6 | 7 | header: 8 | ---------------------------------------- 9 | #lang racket/base 10 | (require racket/file) 11 | ---------------------------------------- 12 | 13 | 14 | no-change-test: 15 | "should not migrate make-temporary-file without 'directory to make-temporary-directory" 16 | - (make-temporary-file #:copy-from #false) 17 | -------------------------------------------------------------------------------- /default-recommendations/file-io-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [file-io-suggestions refactoring-suite?])) 10 | 11 | 12 | (require rebellion/private/static-name 13 | resyntax/base) 14 | 15 | 16 | ;@---------------------------------------------------------------------------------------------------- 17 | 18 | 19 | (define-refactoring-suite file-io-suggestions 20 | #:rules ()) 21 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing / development guidelines 2 | 3 | To install locally for development, run `raco pkg install --auto --link 4 | --installation`. 5 | 6 | To run the tests, use `raco test -p resyntax`. 7 | 8 | It is **recommended** to use either [DrRacket][dr] or [racket-langserver][rls] 9 | with the latest [Racket][rkt] (not `racket-minimal`). 10 | 11 | [dr]: https://docs.racket-lang.org/drracket/ 12 | [rls]: https://pkgs.racket-lang.org/package/racket-langserver 13 | [rkt]: https://download.racket-lang.org/ 14 | -------------------------------------------------------------------------------- /test/testing-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | header: - #lang resyntax/test 5 | 6 | 7 | test: "unnecessary multi-line code blocks in tests refactorable to single-line code blocks" 8 | |------------------- 9 | | test: "foo" 10 | | ------------------ 11 | | (and a (and b c)) 12 | | ================== 13 | | (and a b c) 14 | | ------------------ 15 | |=================== 16 | | test: "foo" 17 | | ------------------ 18 | | (and a (and b c)) 19 | | ------------------ 20 | | ------------------ 21 | | (and a b c) 22 | | ------------------ 23 | |=================== 24 | | test: "foo" 25 | | - (and a (and b c)) 26 | | - (and a b c) 27 | |------------------- 28 | -------------------------------------------------------------------------------- /default-recommendations/private/literal-constant.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide literal-constant) 5 | 6 | 7 | (require syntax/parse) 8 | 9 | 10 | ;@---------------------------------------------------------------------------------------------------- 11 | 12 | 13 | (define-syntax-class literal-constant 14 | #:attributes (value) 15 | #:literals (quote) 16 | 17 | (pattern 18 | (~or (quote literal) 19 | literal:boolean 20 | literal:character 21 | literal:number 22 | literal:regexp 23 | literal:byte-regexp 24 | literal:string 25 | literal:bytes) 26 | #:attr value (syntax->datum #'literal))) 27 | -------------------------------------------------------------------------------- /.github/workflows/autopilot.yml: -------------------------------------------------------------------------------- 1 | name: Autopilot 2 | 3 | on: 4 | workflow_dispatch: 5 | schedule: 6 | # Run at 17:00 UTC every day 7 | # 17:00 UTC is (usually) 10:00 PDT 8 | - cron: "0 17 * * 1,5" 9 | 10 | permissions: 11 | issues: write 12 | 13 | jobs: 14 | assign-issue: 15 | runs-on: ubuntu-latest 16 | steps: 17 | - name: Checkout repository 18 | uses: actions/checkout@v5 19 | - name: Assign issue to copilot 20 | run: | 21 | issue_number=$(gh issue list --state open --label 'autopilot-candidate' --search 'no:assignee -is:blocked' --json number --jq '.[].number' | shuf -n 1) 22 | gh issue edit $issue_number --add-assignee "@copilot" 23 | env: 24 | GH_TOKEN: ${{ secrets.AUTOPILOT_PAT }} 25 | -------------------------------------------------------------------------------- /default-recommendations/private/lambda-by-any-name.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide lambda-by-any-name) 5 | 6 | 7 | (require syntax/parse) 8 | 9 | 10 | ;@---------------------------------------------------------------------------------------------------- 11 | 12 | 13 | ;; λ and lambda aren't free-identifier=?. Additionally, by using a syntax class instead of #:literals 14 | ;; we can produce the same lambda identifier that the input syntax had instead of changing all lambda 15 | ;; identfiers to one of the two cases. There doesn't seem to be a strong community consensus on which 16 | ;; name should be used, so we want to avoid changing the original code's choice. 17 | (define-syntax-class lambda-by-any-name 18 | #:literals (λ lambda) 19 | (pattern (~or λ lambda))) 20 | -------------------------------------------------------------------------------- /private/identifier-naming.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [depluralize-id (-> identifier? identifier?)])) 10 | 11 | 12 | (require racket/string 13 | racket/syntax) 14 | 15 | 16 | ;@---------------------------------------------------------------------------------------------------- 17 | 18 | 19 | (define (depluralize-id id) 20 | (define plural-name (symbol->string (syntax-e id))) 21 | (define singular-name 22 | (cond 23 | [(string-suffix? plural-name "es") (string-trim plural-name "es" #:left? #false)] 24 | [(string-suffix? plural-name "s") (string-trim plural-name "s" #:left? #false)] 25 | [else plural-name])) 26 | (format-id #false "~a" (string->symbol singular-name))) 27 | -------------------------------------------------------------------------------- /private/syntax-range.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [syntax-source-range (-> (and/c syntax? syntax-has-position? syntax-has-span?) range?)])) 10 | 11 | 12 | (require rebellion/base/comparator 13 | rebellion/base/range) 14 | 15 | 16 | ;@---------------------------------------------------------------------------------------------------- 17 | 18 | 19 | (define (syntax-has-position? stx) 20 | (and (syntax-position stx) #true)) 21 | 22 | 23 | (define (syntax-has-span? stx) 24 | (and (syntax-span stx) #true)) 25 | 26 | 27 | (define (syntax-source-range stx) 28 | (closed-open-range (syntax-position stx) (+ (syntax-position stx) (syntax-span stx)) 29 | #:comparator natural<=>)) 30 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/function-expression-analyzer-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations/analyzers/function-expression-analyzer function-expression-analyzer 5 | header: - #lang racket/base 6 | 7 | 8 | analysis-test: "applied functions should be annotated" 9 | -------------------- 10 | (define (f) 11 | (list 1 2 3)) 12 | -------------------- 13 | @within - (list 1 2 3) 14 | @inspect - list 15 | @property application-subexpression-kind 16 | @assert function 17 | 18 | 19 | analysis-test: "applied function arguments should be annotated" 20 | -------------------- 21 | (define (f x y z) 22 | (list x y z)) 23 | -------------------- 24 | @within - (list x y z) 25 | @inspect - y 26 | @property application-subexpression-kind 27 | @assert argument 28 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | 4 | (define collection "resyntax") 5 | 6 | 7 | (define scribblings 8 | (list (list "main.scrbl" 9 | (list 'multi-page) 10 | (list 'library) 11 | "resyntax"))) 12 | 13 | 14 | (define deps 15 | (list "data-lib" 16 | "compatibility-lib" 17 | "base" 18 | "br-parser-tools-lib" 19 | "brag-lib" 20 | "fancy-app" 21 | "fmt" 22 | "guard" 23 | "syntax-color-lib" 24 | "rackunit-lib" 25 | "rebellion")) 26 | 27 | 28 | (define build-deps 29 | (list "racket-doc" 30 | "rackunit-lib" 31 | "scribble-lib")) 32 | 33 | 34 | (define racket-launcher-names 35 | (list "resyntax")) 36 | 37 | 38 | (define racket-launcher-libraries 39 | (list "cli.rkt")) 40 | -------------------------------------------------------------------------------- /.github/workflows/copilot-setup-steps.yml: -------------------------------------------------------------------------------- 1 | name: "Copilot Setup Steps" 2 | 3 | # Automatically run the setup steps when they are changed to allow for easy validation, and 4 | # allow manual testing through the repository's "Actions" tab 5 | on: 6 | workflow_dispatch: 7 | push: 8 | paths: 9 | - .github/workflows/copilot-setup-steps.yml 10 | pull_request: 11 | paths: 12 | - .github/workflows/copilot-setup-steps.yml 13 | 14 | jobs: 15 | copilot-setup-steps: 16 | runs-on: ubuntu-latest 17 | 18 | permissions: 19 | contents: read 20 | 21 | steps: 22 | - uses: actions/checkout@master 23 | - uses: Bogdanp/setup-racket@v1.14 24 | with: 25 | version: stable 26 | - run: raco pkg install --batch --auto cover 27 | - run: raco pkg install --batch --auto --link --name resyntax 28 | -------------------------------------------------------------------------------- /default-recommendations/private/list-function.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide empty-list-by-any-name 5 | empty-predicate-by-any-name 6 | first-by-any-name 7 | rest-by-any-name) 8 | 9 | 10 | (require racket/list 11 | syntax/parse) 12 | 13 | 14 | ;@---------------------------------------------------------------------------------------------------- 15 | 16 | 17 | (define-syntax-class empty-list-by-any-name 18 | #:literals (quote null empty list) 19 | (pattern (~or '() null empty (list)))) 20 | 21 | 22 | (define-syntax-class empty-predicate-by-any-name 23 | #:literals (null? empty?) 24 | (pattern (~or null? empty?))) 25 | 26 | 27 | (define-syntax-class first-by-any-name 28 | #:literals (car first) 29 | (pattern (~or car first))) 30 | 31 | 32 | (define-syntax-class rest-by-any-name 33 | #:literals (cdr rest) 34 | (pattern (~or cdr rest))) 35 | -------------------------------------------------------------------------------- /private/logger.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide log-resyntax-fatal 5 | log-resyntax-error 6 | log-resyntax-warning 7 | log-resyntax-info 8 | log-resyntax-debug 9 | log-resyntax-rule-condition 10 | resyntax-logger) 11 | 12 | 13 | (require (for-syntax racket/base) 14 | syntax/parse/define) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | (define-logger resyntax) 21 | 22 | 23 | (define (log-resyntax-rule-condition-impl v #:line line-num #:datum datum) 24 | (unless v 25 | (log-resyntax-debug "rule condition ~a on line ~a failed" datum line-num)) 26 | v) 27 | 28 | 29 | (define-syntax-parse-rule (log-resyntax-rule-condition expr:expr) 30 | #:with line (syntax-line (attribute expr)) 31 | (log-resyntax-rule-condition-impl expr #:line 'line #:datum 'expr)) 32 | -------------------------------------------------------------------------------- /default-recommendations/private/if-arm.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide if-arm) 5 | 6 | 7 | (require resyntax/base 8 | resyntax/default-recommendations/let-replacement/private/let-binding 9 | syntax/parse) 10 | 11 | 12 | ;@---------------------------------------------------------------------------------------------------- 13 | 14 | 15 | (define-syntax-class if-arm 16 | #:attributes (uses-begin? uses-let? [refactored 1]) 17 | #:literals (begin) 18 | 19 | (pattern (begin body ...) 20 | #:attr uses-begin? #true 21 | #:attr uses-let? #false 22 | #:with (refactored ...) #`(~splicing-replacement (body ...) #:original #,this-syntax)) 23 | 24 | (pattern :refactorable-let-expression 25 | #:attr uses-begin? #false 26 | #:attr uses-let? #true) 27 | 28 | (pattern other 29 | #:with (refactored ...) #'(other) 30 | #:attr uses-begin? #false 31 | #:attr uses-let? #false)) 32 | -------------------------------------------------------------------------------- /default-recommendations/one-line-reformatting-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | header: - #lang racket/base 3 | 4 | 5 | test: "regression test for issue #605" 6 | ---------------------------------------- 7 | (require racket/match) 8 | (define (f expr) 9 | (let loop ([expr expr] 10 | [env '()]) 11 | (match expr 12 | [`(,(and (or '+ '- '* '/ 'and 'or) op) ,as ..2 ,b) `(,op ,(loop `(,op ,@as) env) ,(loop b env))] 13 | [_ (void)]))) 14 | ======================================== 15 | (require racket/match) 16 | (define (f expr) 17 | (let loop ([expr expr] 18 | [env '()]) 19 | (match expr 20 | [`(,(and (or '+ '- '* '/ 'and 'or) op) ,as ..2 ,b) (list op 21 | (loop `(,op ,@as) env) 22 | (loop b env))] 23 | [_ (void)]))) 24 | ---------------------------------------- 25 | -------------------------------------------------------------------------------- /default-recommendations/private/metafunction.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide ~if) 5 | 6 | 7 | (require syntax/parse 8 | syntax/parse/experimental/template) 9 | 10 | 11 | (module+ test 12 | (require racket/syntax 13 | rackunit 14 | rebellion/private/static-name 15 | (submod ".."))) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-template-metafunction (~if stx) 22 | (syntax-parse stx 23 | #:track-literals 24 | [(_ condition true false) 25 | (if (syntax-e #'condition) #'true #'false)])) 26 | 27 | 28 | (module+ test 29 | (test-case (name-string ~if) 30 | (define/with-syntax (condition ...) #'(#true #false #false)) 31 | (define/with-syntax a #'foo) 32 | (define/with-syntax b #'bar) 33 | (define stx #'((~if condition a b) ...)) 34 | (check-equal? (syntax->datum stx) '(foo bar bar)))) 35 | -------------------------------------------------------------------------------- /default-recommendations/syntax-rules-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations syntax-rules-shortcuts 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "single-clause syntax-rules macro refactorable to define-syntax-rule" 12 | ------------------------------ 13 | (define-syntax my-or 14 | (syntax-rules () 15 | [(my-or a b) 16 | (let ([tmp a]) (if a a b))])) 17 | ============================== 18 | (define-syntax-rule (my-or a b) 19 | (let ([tmp a]) (if a a b))) 20 | ------------------------------ 21 | 22 | 23 | test: "single-clause syntax-rules macro not referring to name refactorable to define-syntax-rule" 24 | ------------------------------ 25 | (define-syntax my-or 26 | (syntax-rules () 27 | [(_ a b) 28 | (let ([tmp a]) (if a a b))])) 29 | ============================== 30 | (define-syntax-rule (my-or a b) 31 | (let ([tmp a]) (if a a b))) 32 | ------------------------------ 33 | -------------------------------------------------------------------------------- /default-recommendations/function-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations function-shortcuts 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "apply with cons can be flattened" 12 | - (apply + 0 (cons 1 '(2 3))) 13 | - (apply + 0 1 '(2 3)) 14 | 15 | 16 | test: "apply with recursive cons can be flattened" 17 | - (apply + 0 (cons 1 (cons 2 '(3 4)))) 18 | - (apply + 0 1 2 '(3 4)) 19 | 20 | 21 | test: "apply with list* can be flattened" 22 | - (apply + 0 (list* 1 2 '(3 4))) 23 | - (apply + 0 1 2 '(3 4)) 24 | 25 | 26 | test: "apply with recursive list* can be flattened" 27 | - (apply + 0 (list* 1 2 (list* 3 4 '(5 6)))) 28 | - (apply + 0 1 2 3 4 '(5 6)) 29 | 30 | 31 | test: "apply with quasiquoted list can be flattened" 32 | - (apply + 0 `(1 2 ,@'(3 4))) 33 | - (apply + 0 1 2 '(3 4)) 34 | 35 | 36 | test: "single-case case-lambda refactorable to regular lambda" 37 | - (case-lambda [(x y z) (+ x y z)]) 38 | - (λ (x y z) (+ x y z)) 39 | -------------------------------------------------------------------------------- /default-recommendations/syntax-rules-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [syntax-rules-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require rebellion/private/static-name 13 | resyntax/base 14 | resyntax/private/syntax-replacement 15 | syntax/parse) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-refactoring-rule define-syntax-syntax-rules-to-define-syntax-rule 22 | #:description 23 | "This `define-syntax` macro can be replaced with a simpler, equivalent `define-syntax-rule` macro." 24 | #:literals (define-syntax syntax-rules) 25 | (define-syntax macro:id (syntax-rules () [(_ . pattern) template])) 26 | (define-syntax-rule (macro . pattern) template)) 27 | 28 | 29 | (define-refactoring-suite syntax-rules-shortcuts 30 | #:rules (define-syntax-syntax-rules-to-define-syntax-rule)) 31 | -------------------------------------------------------------------------------- /default-recommendations/legacy/provide-contract-migration-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations provide-contract-migration 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require racket/contract/base) 11 | ------------------------------ 12 | 13 | 14 | test: "provide/contract refactorable to provide with contract-out" 15 | ------------------------------ 16 | (provide/contract [foo integer?]) 17 | (define foo 42) 18 | ============================== 19 | (provide (contract-out [foo integer?])) 20 | (define foo 42) 21 | ------------------------------ 22 | 23 | 24 | test: "provide/contract with unprotected submodule refactorable to provide with contract-out" 25 | ------------------------------ 26 | (provide/contract #:unprotected-submodule unsafe [foo integer?]) 27 | (define foo 42) 28 | ============================== 29 | (provide (contract-out #:unprotected-submodule unsafe [foo integer?])) 30 | (define foo 42) 31 | ------------------------------ 32 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | 7 | build-and-test: 8 | name: Build and Test 9 | runs-on: ubuntu-latest 10 | if: ${{ github.event_name == 'pull_request' || github.actor != 'Copilot' }} 11 | steps: 12 | - uses: actions/checkout@master 13 | - uses: Bogdanp/setup-racket@v1.5 14 | with: 15 | version: stable 16 | - run: raco pkg install --batch --auto --link --name resyntax 17 | - run: raco test --drdr --package resyntax 18 | 19 | code-coverage: 20 | name: Code Coverage 21 | runs-on: ubuntu-latest 22 | steps: 23 | - uses: actions/checkout@master 24 | - uses: Bogdanp/setup-racket@v1.5 25 | with: 26 | version: stable 27 | - run: raco pkg install --batch --auto cover cover-coveralls 28 | - run: raco pkg install --batch --auto --link --name resyntax 29 | - run: raco cover --format coveralls --suppress-log-execution --package resyntax 30 | env: 31 | COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} 32 | -------------------------------------------------------------------------------- /default-recommendations/legacy/provide-contract-migration.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [provide-contract-migration refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | rebellion/private/static-name 14 | resyntax/base 15 | syntax/parse) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-splicing-syntax-class unprotected-submodule-option 22 | (pattern (~optional (~seq #:unprotected-submodule submodule-name)))) 23 | 24 | 25 | (define-refactoring-rule provide/contract-to-contract-out 26 | #:description "The `provide/contract` form is a legacy form made obsolete by `contract-out`." 27 | #:literals (provide/contract) 28 | (provide/contract submod:unprotected-submodule-option item ...) 29 | (provide (contract-out (~@ . submod) item ...))) 30 | 31 | 32 | (define-refactoring-suite provide-contract-migration 33 | #:rules (provide/contract-to-contract-out)) 34 | -------------------------------------------------------------------------------- /private/string-indent.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [string-indent (-> string? #:amount exact-nonnegative-integer? (and/c string? immutable?))] 10 | [string-hanging-indent 11 | (-> string? #:amount exact-nonnegative-integer? (and/c string? immutable?))])) 12 | 13 | 14 | (require racket/string) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | (define (string-indent s #:amount amount) 21 | (define lines 22 | (for/list ([line (in-lines (open-input-string s))]) 23 | (string-append (make-string amount #\space) line))) 24 | (string->immutable-string (string-join lines "\n"))) 25 | 26 | 27 | (define (string-hanging-indent s #:amount amount) 28 | (define lines 29 | (for/list ([line (in-lines (open-input-string s))] 30 | [i (in-naturals)]) 31 | (if (zero? i) 32 | line 33 | (string-append (make-string amount #\space) line)))) 34 | (string->immutable-string (string-join lines "\n"))) 35 | -------------------------------------------------------------------------------- /default-recommendations/console-io-suggestions-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations console-io-suggestions 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "should suggest 'any linemode with read-line when linemode not specified" 12 | ---------------------------------------- 13 | (define (foo in) 14 | (read-line in)) 15 | ======================================== 16 | (define (foo in) 17 | (read-line in 'any)) 18 | ---------------------------------------- 19 | 20 | 21 | test: "should suggest 'any linemode with read-line when linemode and port not specified" 22 | ---------------------------------------- 23 | (define (foo) 24 | (read-line)) 25 | ======================================== 26 | (define (foo) 27 | (read-line (current-input-port) 'any)) 28 | ---------------------------------------- 29 | 30 | 31 | test: "printf to display" 32 | - (printf "foo") 33 | - (display "foo") 34 | 35 | 36 | test: "printf to displayln" 37 | - (printf "foo\nbar\n") 38 | - (displayln "foo\nbar") 39 | 40 | 41 | test: "printf to newline" 42 | - (printf "\n") 43 | - (newline) 44 | -------------------------------------------------------------------------------- /default-recommendations/windows-newline-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (module+ test 5 | (require rackunit 6 | resyntax/default-recommendations 7 | resyntax/test/private/rackunit)) 8 | 9 | 10 | ;@---------------------------------------------------------------------------------------------------- 11 | 12 | 13 | (module+ test 14 | (clear-suites-under-test!) 15 | (clear-header!) 16 | (test-case "windows-style newlines should be replaced with regular newlines" 17 | (parameterize ([current-suite-under-test default-recommendations]) 18 | (define program 19 | (code-block 20 | (string-append "#lang racket/base\r\n" 21 | "(define (foo)\r\n" 22 | " (let ([x 42])\r\n" 23 | " (* x 2)))\r\n"))) 24 | (define expected-program 25 | (code-block 26 | (string-append "#lang racket/base\n" 27 | "(define (foo)\n" 28 | " (define x 42)\n" 29 | " (* x 2))\n"))) 30 | (check-suite-refactors program expected-program)))) 31 | -------------------------------------------------------------------------------- /private/analyzer.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [expansion-analyzer? (-> any/c boolean?)] 10 | [make-expansion-analyzer 11 | (->* ((-> syntax? syntax-property-bundle?)) (#:name (and/c symbol? symbol-interned?)) 12 | expansion-analyzer?)] 13 | [expansion-analyze (-> expansion-analyzer? syntax? syntax-property-bundle?)])) 14 | 15 | 16 | (require rebellion/custom-write 17 | resyntax/private/syntax-property-bundle) 18 | 19 | 20 | ;@---------------------------------------------------------------------------------------------------- 21 | 22 | 23 | (struct expansion-analyzer (name implementation) 24 | #:omit-define-syntaxes 25 | #:constructor-name constructor:expansion-analyzer 26 | #:property prop:object-name (struct-field-index name) 27 | #:property prop:custom-write (make-named-object-custom-write 'expansion-analyzer)) 28 | 29 | 30 | (define (make-expansion-analyzer implementation #:name [name #false]) 31 | (constructor:expansion-analyzer name implementation)) 32 | 33 | 34 | (define (expansion-analyze analyzer expanded-syntax) 35 | ((expansion-analyzer-implementation analyzer) expanded-syntax)) 36 | -------------------------------------------------------------------------------- /default-recommendations/let-binding-suggestions-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations let-binding-suggestions 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | test: "named lets which don't refer to the name are refactorable to unnamed lets" 10 | - (let loop ([x 1]) x) 11 | - (let ([x 1]) x) 12 | 13 | 14 | no-change-test: "named lets which do refer to the name aren't refactorable to unnamed lets" 15 | ------------------------------ 16 | (let loop ([x 1]) 17 | (if (zero? x) 18 | x 19 | (loop (sub1 x)))) 20 | ------------------------------ 21 | 22 | 23 | test: "let-values expressions with an immediate call are refactorable to call-with-values" 24 | - (let-values ([(x y z) (values 1 2 3)]) (list x y z)) 25 | - (call-with-values (λ () (values 1 2 3)) list) 26 | 27 | 28 | no-change-test: 29 | "let-values expressions with an immediate call with different order aren't refactorable" 30 | - (let-values ([(x y z) (values 1 2 3)]) (list z y x)) 31 | test: "redundant let bindings can be removed" 32 | ------------------------------ 33 | (define x 1) 34 | (let ([x x]) 35 | (* x 2)) 36 | ============================== 37 | (define x 1) 38 | (* x 2) 39 | ------------------------------ 40 | -------------------------------------------------------------------------------- /default-recommendations/legacy/make-temporary-directory-migration-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations make-temporary-directory-migration 5 | 6 | 7 | header: 8 | ---------------------------------------- 9 | #lang racket/base 10 | (require racket/file) 11 | ---------------------------------------- 12 | 13 | 14 | test: "should migrate make-temporary-file with 'directory to make-temporary-directory" 15 | - (void (make-temporary-file #:copy-from 'directory)) 16 | - (void (make-temporary-directory)) 17 | 18 | 19 | test: "should migrate make-temporary-file with template and 'directory to make-temporary-directory" 20 | - (void (make-temporary-file "footmp~a" #:copy-from 'directory)) 21 | - (void (make-temporary-file "footmp~a" 'directory)) 22 | - (void (make-temporary-directory "footmp~a")) 23 | 24 | 25 | test: "should migrate make-temporary-file with base-dir and 'directory to make-temporary-directory" 26 | - (void (make-temporary-file #:base-dir #false #:copy-from 'directory)) 27 | - (void (make-temporary-directory #:base-dir #false)) 28 | 29 | 30 | no-change-test: 31 | "should not migrate make-temporary-file without 'directory to make-temporary-directory" 32 | - (make-temporary-file #:copy-from #false) 33 | -------------------------------------------------------------------------------- /default-recommendations/private/syntax-identifier-sets.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [in-syntax-identifiers (-> syntax? (sequence/c identifier?))] 10 | [syntax-identifiers (-> syntax? (set/c identifier? #:cmp 'equal))] 11 | [syntax-free-identifiers (-> syntax? immutable-free-id-set?)] 12 | [syntax-bound-identifiers (-> syntax? immutable-bound-id-set?)])) 13 | 14 | 15 | (require guard 16 | racket/sequence 17 | racket/set 18 | racket/stream 19 | resyntax/private/syntax-traversal 20 | syntax/id-set 21 | syntax/parse) 22 | 23 | 24 | ;@---------------------------------------------------------------------------------------------------- 25 | 26 | 27 | (define (in-syntax-identifiers stx) 28 | (syntax-search stx 29 | #:datum-literals (quote) 30 | [(quote _) (stream)] 31 | [:id])) 32 | 33 | 34 | (define (syntax-identifiers stx) 35 | (for/set ([id (in-syntax-identifiers stx)]) 36 | id)) 37 | 38 | 39 | (define (syntax-free-identifiers stx) 40 | (immutable-free-id-set (syntax-identifiers stx))) 41 | 42 | 43 | (define (syntax-bound-identifiers stx) 44 | (immutable-bound-id-set (syntax-identifiers stx))) 45 | -------------------------------------------------------------------------------- /test/private/grammar.rkt: -------------------------------------------------------------------------------- 1 | #lang brag 2 | 3 | 4 | program: statement* 5 | statement: IDENTIFIER /COLON (option | expression | code-block-sequence)+ 6 | option: /AT-SIGN IDENTIFIER expression 7 | 8 | 9 | @expression: code-line 10 | | standalone-code-block 11 | | prefixed-standalone-code-block 12 | | range-set 13 | | IDENTIFIER 14 | | LITERAL-STRING 15 | | LITERAL-INTEGER 16 | 17 | 18 | code-line: /SINGLE-DASH CODE-LINE 19 | standalone-code-block: /DASH-LINE CODE-LINE* /DASH-LINE 20 | prefixed-standalone-code-block: /PIPE-DASH-LINE (/PIPE-SPACE CODE-LINE)* /PIPE-DASH-LINE 21 | 22 | 23 | @code-block-sequence: first-code-block middle-code-block* last-code-block+ 24 | | prefixed-first-code-block prefixed-middle-code-block* prefixed-last-code-block+ 25 | 26 | 27 | first-code-block: /DASH-LINE CODE-LINE* /EQUALS-LINE 28 | middle-code-block: CODE-LINE* /EQUALS-LINE 29 | last-code-block: CODE-LINE* /DASH-LINE 30 | 31 | 32 | prefixed-first-code-block: /PIPE-DASH-LINE (/PIPE-SPACE CODE-LINE)* /PIPE-EQUALS-LINE 33 | prefixed-middle-code-block: (/PIPE-SPACE CODE-LINE)* /PIPE-EQUALS-LINE 34 | prefixed-last-code-block: (/PIPE-SPACE CODE-LINE)* /PIPE-DASH-LINE 35 | 36 | 37 | range-set: line-range (/COMMA line-range)* 38 | line-range: LITERAL-INTEGER /DOUBLE-DOT LITERAL-INTEGER 39 | -------------------------------------------------------------------------------- /default-recommendations/unused-binding-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [unused-binding-suggestions refactoring-suite?])) 10 | 11 | 12 | (require racket/list 13 | resyntax/base 14 | resyntax/default-recommendations/analyzers/identifier-usage 15 | resyntax/default-recommendations/private/pure-expression 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-syntax-class side-effect-free-definition 23 | #:attributes (id) 24 | #:literals (define) 25 | (pattern (define (id:id . _) . _)) 26 | (pattern (define id:id :pure-expression))) 27 | 28 | 29 | (define-definition-context-refactoring-rule unused-definition 30 | #:description "This definition is not used." 31 | #:analyzers (list identifier-usage-analyzer) 32 | (~seq before ... definition:side-effect-free-definition first-after remaining-after ...) 33 | #:when (equal? (syntax-property (attribute definition.id) 'usage-count) 0) 34 | (before ... 35 | (~focus-replacement-on (~replacement first-after #:original-splice (definition first-after))) 36 | remaining-after ...)) 37 | 38 | 39 | (define-refactoring-suite unused-binding-suggestions 40 | #:rules (unused-definition)) 41 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/let-replacement-nesting-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations let-replacement 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "nested let bindings" 12 | ------------------------------ 13 | (define (f) 14 | (let ([x 1]) 15 | (let ([y 1]) 16 | (let ([z 1]) 17 | (+ x y z))))) 18 | ============================== 19 | (define (f) 20 | (define x 1) 21 | (define y 1) 22 | (define z 1) 23 | (+ x y z)) 24 | ------------------------------ 25 | 26 | 27 | test: "nested let bindings with interleaved expressions" 28 | ------------------------------ 29 | (define (f) 30 | (let ([x 1]) 31 | (displayln "foo") 32 | (let ([y 1]) 33 | (displayln "bar") 34 | (let ([z 1]) 35 | (+ x y z))))) 36 | ============================== 37 | (define (f) 38 | (define x 1) 39 | (displayln "foo") 40 | (define y 1) 41 | (displayln "bar") 42 | (define z 1) 43 | (+ x y z)) 44 | ------------------------------ 45 | 46 | 47 | test: "nested conflicting let bindings only partially refactorable" 48 | ------------------------------ 49 | (define (f) 50 | (let ([x 1]) 51 | (displayln x) 52 | (let ([x 2]) 53 | x))) 54 | ============================== 55 | (define (f) 56 | (define x 1) 57 | (displayln x) 58 | (let ([x 2]) x)) 59 | ------------------------------ 60 | -------------------------------------------------------------------------------- /default-recommendations/numeric-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations numeric-shortcuts 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "lambda equivalent to add1 refactorable to add1" 12 | - (map (λ (x) (+ x 1)) (list 1 2 3)) 13 | - (map (λ (x) (+ 1 x)) (list 1 2 3)) 14 | - (map add1 (list 1 2 3)) 15 | 16 | 17 | test: "lambda equivalent to sub1 refactorable to sub1" 18 | - (map (λ (x) (- x 1)) (list 1 2 3)) 19 | - (map (λ (x) (+ x -1)) (list 1 2 3)) 20 | - (map (λ (x) (+ -1 x)) (list 1 2 3)) 21 | - (map sub1 (list 1 2 3)) 22 | 23 | 24 | test: "lambda equivalent to positive? refactorable to positive?" 25 | - (filter (λ (x) (> x 0)) (list -2 -1 0 1 2)) 26 | - (filter (λ (x) (< 0 x)) (list -2 -1 0 1 2)) 27 | - (filter (λ (x) (not (<= x 0))) (list -2 -1 0 1 2)) 28 | - (filter (λ (x) (not (>= 0 x))) (list -2 -1 0 1 2)) 29 | - (filter positive? (list -2 -1 0 1 2)) 30 | 31 | 32 | test: "lambda equivalent to negative? refactorable to negative?" 33 | - (filter (λ (x) (< x 0)) (list -2 -1 0 1 2)) 34 | - (filter (λ (x) (> 0 x)) (list -2 -1 0 1 2)) 35 | - (filter (λ (x) (not (>= x 0))) (list -2 -1 0 1 2)) 36 | - (filter (λ (x) (not (<= 0 x))) (list -2 -1 0 1 2)) 37 | - (filter negative? (list -2 -1 0 1 2)) 38 | 39 | 40 | test: "addition of a single term is identity" 41 | - (+ 1) 42 | - 1 43 | 44 | 45 | test: "multiplication of a single term is identity" 46 | - (* 512) 47 | - 512 48 | -------------------------------------------------------------------------------- /private/scribble-evaluator-factory.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (module doc racket/base 5 | 6 | 7 | (require racket/contract/base) 8 | 9 | 10 | (provide 11 | (contract-out 12 | [evaluator/c contract?] 13 | [evaluator-factory? (-> any/c boolean?)] 14 | [evaluator-factory-create (-> evaluator-factory? evaluator/c)] 15 | [make-module-sharing-evaluator-factory 16 | (->* () 17 | (#:private (listof module-path?) 18 | #:public (listof module-path?)) 19 | evaluator-factory?)])) 20 | 21 | 22 | (require racket/list 23 | scribble/example) 24 | 25 | 26 | ;@---------------------------------------------------------------------------- 27 | 28 | 29 | (define evaluator/c (-> any/c any/c)) 30 | 31 | 32 | (struct evaluator-factory (thunk) 33 | #:constructor-name make-evaluator-factory 34 | #:property prop:procedure 0) 35 | 36 | 37 | (define (evaluator-factory-create factory) 38 | ((evaluator-factory-thunk factory))) 39 | 40 | 41 | (define (make-module-sharing-evaluator-factory 42 | #:public [public-modules empty] 43 | #:private [private-modules empty]) 44 | (define base-factory 45 | (make-base-eval-factory (append private-modules public-modules))) 46 | (define (factory) 47 | (define evaluator (base-factory)) 48 | (evaluator `(require ,@public-modules)) 49 | evaluator) 50 | (make-evaluator-factory factory))) 51 | -------------------------------------------------------------------------------- /default-recommendations/class-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations class-shortcuts 5 | 6 | 7 | header: 8 | -------------------- 9 | #lang racket/base 10 | (require racket/class) 11 | -------------------- 12 | 13 | 14 | test: "nested send expressions refactorable to flat send+ expression" 15 | -------------------- 16 | (define (f obj x y z) 17 | (send (send (send obj m1 x) m2 y) m3 z)) 18 | ==================== 19 | (define (f obj x y z) 20 | (send+ obj (m1 x) (m2 y) (m3 z))) 21 | -------------------- 22 | 23 | 24 | no-change-test: "two-method nested send expression not refactorable to send+" 25 | -------------------- 26 | (define (f obj x y) 27 | (send (send obj m1 x) m2 y)) 28 | -------------------- 29 | 30 | 31 | test: "instantiate without by-name arguments refactorable to make-object" 32 | -------------------- 33 | (define (f cls x y z) 34 | (instantiate cls (x y z))) 35 | ==================== 36 | (define (f cls x y z) 37 | (make-object cls x y z)) 38 | -------------------- 39 | 40 | 41 | test: "instantiate without by-position arguments refactorable to new" 42 | -------------------- 43 | (define (f cls x y z) 44 | (instantiate cls () [x x] [y y] [z z])) 45 | ==================== 46 | (define (f cls x y z) 47 | (new cls [x x] [y y] [z z])) 48 | -------------------- 49 | 50 | 51 | no-change-test: "instantiate without any arguments not refactorable" 52 | -------------------- 53 | (define (f cls) 54 | (instantiate cls ())) 55 | -------------------- 56 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/unwanted-suggestion-report.yaml: -------------------------------------------------------------------------------- 1 | name: Unwanted suggestion report 2 | title: Unwanted suggestion from `rule-name-here` 3 | description: Report a bug where Resyntax suggested an unwanted refactoring 4 | labels: 5 | - bug 6 | - existing lint 7 | body: 8 | - type: textarea 9 | attributes: 10 | label: Problem summary 11 | description: Give a brief summary of the unwanted suggestion Resyntax made and why it's undesirable. If possible, include links to publicly viewable code where Resyntax tried to apply this suggestion. 12 | placeholder: Resyntax suggested changing `foo` to `bar` in octocat/neat-project#123, but this breaks the code. 13 | validations: 14 | required: true 15 | - type: textarea 16 | attributes: 17 | label: Test case for code that shouldn't be refactored 18 | description: What code did Resyntax make an unwanted suggestion about? Put the code inside this test case. 19 | value: | 20 | #lang resyntax/test 21 | 22 | no-change-test: "this code should not be refactored" 23 | -------------------- 24 | #lang racket 25 | ;; Put the original code here 26 | -------------------- 27 | render: scheme 28 | validations: 29 | required: true 30 | - type: textarea 31 | attributes: 32 | label: Unwanted suggestion 33 | description: What code did Resyntax suggest that you don't want? 34 | value: | 35 | #lang racket 36 | ;; Put Resyntax's unwanted suggestion here 37 | render: scheme 38 | validations: 39 | required: true 40 | -------------------------------------------------------------------------------- /default-recommendations/unused-binding-suggestions-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations unused-binding-suggestions 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "should remove unused function definitions from internal definition contexts" 12 | ------------------------------ 13 | (define (foo) 14 | (define (bar) 15 | (displayln "bar")) 16 | 42) 17 | ============================== 18 | (define (foo) 19 | 42) 20 | ------------------------------ 21 | 22 | 23 | no-change-test: "should not remove used function definitions from internal definition contexts" 24 | ------------------------------ 25 | (define (foo) 26 | (define (bar) 27 | (displayln "bar")) 28 | (bar) 29 | 42) 30 | ------------------------------ 31 | 32 | 33 | test: "removing unused function definitions shouldn't reformat entire context" 34 | ------------------------------ 35 | (define (foo) 36 | ( displayln "foo" ) 37 | 38 | 39 | (define (bar) 40 | (displayln "bar")) 41 | 42 | (define x 2) 43 | ( * x 2 )) 44 | ============================== 45 | (define (foo) 46 | ( displayln "foo" ) 47 | 48 | 49 | (define x 2) 50 | ( * x 2 )) 51 | ------------------------------ 52 | 53 | 54 | test: "should remove unused side-effect-free variable definitions from internal definition contexts" 55 | ------------------------------ 56 | (define (foo) 57 | (define bar "bar") 58 | 42) 59 | ============================== 60 | (define (foo) 61 | 42) 62 | ------------------------------ 63 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/let-replacement-function-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations let-replacement 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "let binding to lambda" 12 | ------------------------------ 13 | (define (f) 14 | (let ([g (λ (x y) 1)]) 15 | g)) 16 | ============================== 17 | (define (f) 18 | (define (g x y) 19 | 1) 20 | g) 21 | ------------------------------ 22 | 23 | 24 | test: "let binding to lambda with keyword args" 25 | ------------------------------ 26 | (define (f) 27 | (let ([g (λ (#:x x #:y y) 1)]) 28 | g)) 29 | ============================== 30 | (define (f) 31 | (define (g #:x x #:y y) 32 | 1) 33 | g) 34 | ------------------------------ 35 | 36 | 37 | test: "let binding to lambda with optional args" 38 | ------------------------------ 39 | (define (f) 40 | (let ([g (λ ([x 1] [y 1]) 1)]) 41 | g)) 42 | ============================== 43 | (define (f) 44 | (define (g [x 1] [y 1]) 45 | 1) 46 | g) 47 | ------------------------------ 48 | 49 | 50 | test: "let binding to lambda with only rest args" 51 | ------------------------------ 52 | (define (f) 53 | (let ([g (λ xs 1)]) 54 | g)) 55 | ============================== 56 | (define (f) 57 | (define (g . xs) 58 | 1) 59 | g) 60 | ------------------------------ 61 | 62 | 63 | test: "let binding to lambda with positional and rest args" 64 | ------------------------------ 65 | (define (f) 66 | (let ([g (λ (x y . zs) 1)]) 67 | g)) 68 | ============================== 69 | (define (f) 70 | (define (g x y . zs) 71 | 1) 72 | g) 73 | ------------------------------ 74 | -------------------------------------------------------------------------------- /default-recommendations/private/exception.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide always-throwing-expression) 5 | 6 | 7 | (require racket/contract/combinator 8 | racket/generic 9 | syntax/parse 10 | syntax/readerr) 11 | 12 | 13 | ;@---------------------------------------------------------------------------------------------------- 14 | 15 | 16 | (define-syntax-class always-throwing-expression 17 | #:literals (raise 18 | error 19 | raise-user-error 20 | raise-argument-error 21 | raise-result-error 22 | raise-arguments-error 23 | raise-range-error 24 | raise-type-error 25 | raise-mismatch-error 26 | raise-arity-error 27 | raise-arity-mask-error 28 | raise-result-arity-error 29 | raise-syntax-error 30 | raise-read-error 31 | raise-read-eof-error 32 | raise-blame-error 33 | raise-support-error) 34 | (pattern ((~or raise 35 | error 36 | raise-user-error 37 | raise-argument-error 38 | raise-result-error 39 | raise-arguments-error 40 | raise-range-error 41 | raise-type-error 42 | raise-mismatch-error 43 | raise-arity-error 44 | raise-arity-mask-error 45 | raise-result-arity-error 46 | raise-syntax-error 47 | raise-read-error 48 | raise-read-eof-error 49 | raise-blame-error 50 | raise-support-error) 51 | arg ...))) 52 | -------------------------------------------------------------------------------- /default-recommendations/console-io-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [console-io-suggestions refactoring-suite?])) 10 | 11 | 12 | (require racket/file 13 | racket/list 14 | racket/string 15 | rebellion/private/static-name 16 | resyntax/base 17 | syntax/parse) 18 | 19 | 20 | ;@---------------------------------------------------------------------------------------------------- 21 | 22 | 23 | (define-refactoring-rule read-line-any 24 | #:description 25 | (string-append "Specify a line mode of `'any` with `read-line` to avoid differences between " 26 | "Windows and other platforms.") 27 | #:literals (read-line) 28 | (read-line (~optional port)) 29 | (read-line (~? port (current-input-port)) 'any)) 30 | 31 | 32 | (define-syntax-class printf-without-specifiers 33 | #:attributes (refactored) 34 | #:literals (printf) 35 | 36 | (pattern (printf "\n") 37 | #:with refactored #'(newline)) 38 | 39 | (pattern (printf s:str) 40 | #:when (string-suffix? (syntax-e #'s) "\n") 41 | #:with stripped (substring (syntax-e #'s) 0 (- (string-length (syntax-e #'s)) 1)) 42 | #:with refactored #'(displayln stripped)) 43 | 44 | (pattern (printf s:str) 45 | #:with refactored #'(display s))) 46 | 47 | 48 | (define-refactoring-rule printf-to-display 49 | #:description 50 | "This use of `printf` has no arguments other than the template string." 51 | expr:printf-without-specifiers 52 | expr.refactored) 53 | 54 | 55 | (define-refactoring-suite console-io-suggestions 56 | #:rules (printf-to-display 57 | read-line-any)) 58 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-struct-migrations.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [legacy-struct-migrations refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | racket/syntax 14 | rebellion/private/static-name 15 | resyntax/base 16 | resyntax/private/syntax-replacement 17 | syntax/parse) 18 | 19 | 20 | ;@---------------------------------------------------------------------------------------------------- 21 | 22 | 23 | (define-syntax-class id-maybe-super 24 | #:attributes (make-id [migrated 1]) 25 | 26 | (pattern id:id 27 | #:with (migrated ...) #'(id) 28 | #:with make-id (format-id #'id "make-~a" #'id)) 29 | 30 | (pattern (id:id super-id:id) 31 | #:with (migrated ...) #'(id super-id) 32 | #:with make-id (format-id #'id "make-~a" #'id))) 33 | 34 | 35 | (define-syntax-class constructor-name-keyword 36 | (pattern (~or #:constructor-name #:extra-constructor-name))) 37 | 38 | 39 | (define-splicing-syntax-class struct-option 40 | #:attributes (keyword [expr 1] [original 1]) 41 | (pattern (~seq (~and keyword:keyword (~not :constructor-name-keyword)) expr:expr ...) 42 | #:with (original ...) #'(keyword expr ...))) 43 | 44 | 45 | (define-refactoring-rule define-struct-to-struct 46 | #:description "The `define-struct` form exists for backwards compatibility, `struct` is preferred." 47 | #:literals (define-struct) 48 | (define-struct id:id-maybe-super fields option:struct-option ...) 49 | (struct id.migrated ... fields option.original ... ... 50 | #:extra-constructor-name id.make-id)) 51 | 52 | 53 | (define-refactoring-suite legacy-struct-migrations 54 | #:rules (define-struct-to-struct)) 55 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # resyntax [![CI Status][ci-status-badge]][ci-status] [![Documentation][docs-badge]][docs] [![Coverage Status][coverage-badge]][coverage] 2 | 3 | A refactoring tool for Racket built on top of `syntax-parse`. 4 | 5 | [ci-status]: https://github.com/jackfirth/resyntax/actions 6 | [ci-status-badge]: https://github.com/jackfirth/resyntax/workflows/CI/badge.svg 7 | [docs]: https://docs.racket-lang.org/resyntax/index.html 8 | [docs-badge]: https://img.shields.io/badge/docs-published-blue.svg 9 | [coverage]: https://coveralls.io/github/jackfirth/resyntax?branch=master 10 | [coverage-badge]: https://coveralls.io/repos/github/jackfirth/resyntax/badge.svg?branch=master 11 | 12 | ## Quickstart 13 | 14 | Use the Racket package manager to install in the installation scope. 15 | ``` 16 | raco pkg install --installation resyntax 17 | ``` 18 | The `--installation` flag (shorthand for `--scope installation`) installs packages for all users of a Racket installation and ensures `resyntax` is in your `$PATH`. 19 | 20 | e.g. 21 | ``` 22 | % resyntax analyze --file coroutines-example.rkt 23 | resyntax: --- analyzing code --- 24 | resyntax: --- displaying results --- 25 | % 26 | ``` 27 | 28 | See the documentation for more details on how to use `resyntax`. 29 | 30 | ## Examples 31 | 32 | Resyntax integrates with GitHub in two ways: an _analyzer_ GitHub action that reviews pull requests, and an _autofixer_ GitHub action that periodically creates pull requests cleaning up a repository. You can find reviews the Resyntax analyzer has left on GitHub pull requests "in the wild" using [this search](https://github.com/search?q=%22Resyntax%20analyzed%22%20%22added%20suggestions%22%20in%3Acomments%20is%3Apr%20sort%3Aupdated%20&type=pullrequests). To find pull requests created by the autofixer, use [this search](https://github.com/search?q=author%3Aapp%2Fresyntax-ci&type=pullrequests). 33 | -------------------------------------------------------------------------------- /default-recommendations/private/syntax-lines.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [oneline-syntax? (-> any/c boolean?)] 10 | [multiline-syntax? (-> any/c boolean?)])) 11 | 12 | 13 | (require rebellion/streaming/reducer 14 | rebellion/streaming/transducer 15 | resyntax/private/syntax-traversal) 16 | 17 | 18 | (module+ test 19 | (require rackunit 20 | rebellion/private/static-name 21 | (submod ".."))) 22 | 23 | 24 | ;@---------------------------------------------------------------------------------------------------- 25 | 26 | 27 | (define (oneline-syntax? v) 28 | (and (syntax? v) (equal? (syntax-line-count v) 1))) 29 | 30 | 31 | (define (multiline-syntax? v) 32 | (and (syntax? v) (> (syntax-line-count v) 1))) 33 | 34 | 35 | (define (syntax-line-count stx) 36 | (transduce (syntax-search stx [:atom]) 37 | (mapping syntax-line) 38 | (deduplicating) 39 | #:into into-count)) 40 | 41 | 42 | (module+ test 43 | (test-case (name-string oneline-syntax?) 44 | (check-true (oneline-syntax? #'a)) 45 | (check-true (oneline-syntax? #'(a b c))) 46 | (check-false (oneline-syntax? #'(a 47 | b 48 | c))) 49 | (check-false (oneline-syntax? #'(1 50 | 2 51 | 3)))) 52 | 53 | (test-case (name-string multiline-syntax?) 54 | (check-false (multiline-syntax? #'a)) 55 | (check-false (multiline-syntax? #'(a b c))) 56 | (check-true (multiline-syntax? #'(a 57 | b 58 | c))) 59 | (check-true (multiline-syntax? #'(1 60 | 2 61 | 3))))) 62 | -------------------------------------------------------------------------------- /default-recommendations/let-binding-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [let-binding-suggestions refactoring-suite?])) 10 | 11 | 12 | (require racket/list 13 | racket/set 14 | resyntax/base 15 | resyntax/default-recommendations/private/syntax-equivalence 16 | resyntax/default-recommendations/private/syntax-identifier-sets 17 | syntax/parse) 18 | 19 | 20 | ;@---------------------------------------------------------------------------------------------------- 21 | 22 | 23 | (define-refactoring-rule named-let-to-plain-let 24 | #:description 25 | "This named `let` loop doesn't actually perform any recursive calls, and can be replaced with an\ 26 | unnamed `let`." 27 | #:literals (let) 28 | (let name:id header body ...) 29 | #:when (not (set-member? (syntax-free-identifiers #'(body ...)) #'name)) 30 | (let header body ...)) 31 | 32 | 33 | (define-refactoring-rule let-values-then-call-to-call-with-values 34 | #:description 35 | "This `let-values` expression can be replaced with a simpler, equivalent `call-with-values`\ 36 | expression." 37 | #:literals (let-values) 38 | (let-values ([(bound-id:id ...+) expr]) 39 | (receiver:id arg-id:id ...+)) 40 | #:when (syntax-free-identifier=? #'(bound-id ...) #'(arg-id ...)) 41 | (call-with-values (λ () expr) receiver)) 42 | 43 | 44 | (define-refactoring-rule delete-redundant-let 45 | #:description "This `let` binding does nothing and can be removed." 46 | #:literals (let) 47 | (let ([left-id:id right-id:id]) body) 48 | #:when (equal? (syntax-e (attribute left-id)) (syntax-e (attribute right-id))) 49 | body) 50 | 51 | 52 | (define-refactoring-suite let-binding-suggestions 53 | #:rules (delete-redundant-let 54 | let-values-then-call-to-call-with-values 55 | named-let-to-plain-let)) 56 | -------------------------------------------------------------------------------- /default-recommendations/comparison-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations comparison-shortcuts 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (define x 1) 11 | (define y 2) 12 | ------------------------------ 13 | 14 | 15 | test: "comparison of difference to zero refactorable to direct > comparison" 16 | - (> (- x y) 0) 17 | - (< 0 (- x y)) 18 | - (> x y) 19 | 20 | 21 | test: "comparison of difference to zero refactorable to direct < comparison" 22 | - (< (- x y) 0) 23 | - (> 0 (- x y)) 24 | - (< x y) 25 | 26 | 27 | test: "comparison of difference to zero refactorable to direct >= comparison" 28 | - (<= 0 (- x y)) 29 | - (>= (- x y) 0) 30 | - (>= x y) 31 | 32 | 33 | test: "comparison of difference to zero refactorable to direct <= comparison" 34 | - (>= 0 (- x y)) 35 | - (<= (- x y) 0) 36 | - (<= x y) 37 | 38 | 39 | test: "two double comparisons with same subject refactorable to triple < comparison" 40 | - (and (< x 10) (> x -10)) 41 | - (and (< x 10) (< -10 x)) 42 | - (and (> 10 x) (> x -10)) 43 | - (and (> 10 x) (< -10 x)) 44 | - (and (> x -10) (< x 10)) 45 | - (and (< -10 x) (< x 10)) 46 | - (and (> x -10) (> 10 x)) 47 | - (and (< -10 x) (> 10 x)) 48 | - (< -10 x 10) 49 | 50 | 51 | test: "two double comparisons with same subject refactorable to triple <= comparison" 52 | - (and (<= x 10) (>= x -10)) 53 | - (and (<= x 10) (<= -10 x)) 54 | - (and (>= 10 x) (>= x -10)) 55 | - (and (>= 10 x) (<= -10 x)) 56 | - (and (>= x -10) (<= x 10)) 57 | - (and (<= -10 x) (<= x 10)) 58 | - (and (>= x -10) (>= 10 x)) 59 | - (and (<= -10 x) (>= 10 x)) 60 | - (<= -10 x 10) 61 | 62 | 63 | no-change-test: 64 | "or-comparisons not refactorable (see https://github.com/jackfirth/resyntax/issues/144)" 65 | - (or (< x 2) (> x 36)) 66 | 67 | 68 | no-change-test: "mixed inclusive and exclusive comparisons not refactorable" 69 | - (and (< x 10) (>= x -10)) 70 | -------------------------------------------------------------------------------- /default-recommendations/legacy/define-simple-macro-migration.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [define-simple-macro-migration refactoring-suite?])) 10 | 11 | 12 | (require resyntax/base 13 | resyntax/default-recommendations/private/syntax-lines 14 | syntax/parse/define) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | (define define-simple-macro-migration-name-length-increase 21 | (- (string-length "define-syntax-parse-rule") (string-length "define-simple-macro"))) 22 | 23 | (define-refactoring-rule define-simple-macro-to-define-syntax-parse-rule 24 | #:description "The `define-simple-macro` form has been renamed to `define-syntax-parse-rule`." 25 | #:literals (define-simple-macro) 26 | (original:define-simple-macro header form ...) 27 | 28 | ;; The define-simple-macro is a renamed alias of define-syntax-parse-rule, so it's 29 | ;; free-identifier=?. As a result, we need to check the actual symbol of the identifier instead of 30 | ;; just its binding. See https://github.com/jackfirth/resyntax/issues/106. 31 | #:when (equal? (syntax-e #'original) 'define-simple-macro) 32 | 33 | #:do 34 | [(define should-reformat? 35 | (or (multiline-syntax? #'header) 36 | (not (equal? (syntax-line #'original) (syntax-line #'header))) 37 | (> (+ (syntax-column #'header) 38 | (syntax-span #'header) 39 | define-simple-macro-migration-name-length-increase) 40 | 102)))] 41 | 42 | #:with new-id (if should-reformat? 43 | #'define-syntax-parse-rule 44 | #'(~focus-replacement-on define-syntax-parse-rule)) 45 | 46 | (new-id header form ...)) 47 | 48 | 49 | (define-refactoring-suite define-simple-macro-migration 50 | #:rules (define-simple-macro-to-define-syntax-parse-rule)) 51 | -------------------------------------------------------------------------------- /.github/workflows/resyntax-analyze.yml: -------------------------------------------------------------------------------- 1 | name: Resyntax Analysis 2 | 3 | # The Resyntax integration is split into two phases: a workflow that analyzes the code and uploads 4 | # the analysis as an artifact, and a workflow that downloads the analysis artifact and creates a 5 | # review of the pull request. This split is for permissions reasons; the analysis workflow checks out 6 | # the pull request branch and compiles it, executing arbitrary code as it does so. For that reason, 7 | # the first workflow has read-only permissions in the github repository. The second workflow only 8 | # downloads the pull request review artifact and submits it, and it executes with read-write permissions 9 | # without executing any code in the repository. This division of responsibilities allows Resyntax to 10 | # safely analyze pull requests from forks. This strategy is outlined in the following article: 11 | # https://securitylab.github.com/research/github-actions-preventing-pwn-requests/ 12 | 13 | on: 14 | pull_request: 15 | types: 16 | - opened 17 | - reopened 18 | - synchronize 19 | - ready_for_review 20 | 21 | jobs: 22 | analyze: 23 | runs-on: ubuntu-latest 24 | if: ${{ github.triggering_actor != 'resyntax-ci[bot]' }} 25 | env: 26 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 27 | 28 | steps: 29 | - name: Checkout code 30 | uses: actions/checkout@v5.0.0 31 | # See https://github.com/actions/checkout/issues/118. 32 | with: 33 | fetch-depth: 0 34 | - uses: Bogdanp/setup-racket@v1.5 35 | with: 36 | version: stable 37 | - run: raco pkg install --batch --auto --link --name resyntax 38 | - name: Analyze changed files 39 | run: racket -l- resyntax/cli analyze --local-git-repository . "origin/${GITHUB_BASE_REF}" --output-as-github-review --output-to-file ./resyntax-review.json 40 | - name: Upload analysis artifact 41 | uses: actions/upload-artifact@v4.6.1 42 | with: 43 | name: resyntax-review 44 | path: resyntax-review.json 45 | -------------------------------------------------------------------------------- /private/run-command.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [run-command (-> string? path-string? ... string?)])) 10 | 11 | 12 | (require racket/port 13 | racket/string 14 | rebellion/private/static-name) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | ; This doesn't support anything but getting stdout -- but that's OK for now! 21 | (define (run-command cmd-name . args) 22 | (define stringified-args (map (λ (arg) (if (path? arg) (path->string arg) arg)) args)) 23 | (define cmd-path 24 | (or (find-executable-path cmd-name) 25 | ; Racket doesn't know about $PATHEXT: 26 | (find-executable-path (string-append cmd-name ".exe")))) 27 | (unless cmd-path 28 | (raise-arguments-error (name run-command) 29 | "couldn't find executable in $PATH" 30 | "executable" cmd-name)) 31 | (define-values (proc stdout stdin stderr) 32 | (apply subprocess #f #f #f cmd-path args)) 33 | (close-output-port stdin) 34 | (subprocess-wait proc) 35 | (define exit-code (subprocess-status proc)) 36 | (define stdout-string (port->string stdout)) 37 | (define stderr-string (string-trim (port->string stderr))) 38 | (close-input-port stdout) 39 | (close-input-port stderr) 40 | (unless (zero? exit-code) 41 | (raise-arguments-error (name run-command) 42 | "command exited with a nonzero exit code" 43 | "command" (string-join (cons cmd-name stringified-args) " ") 44 | "exit code" exit-code 45 | "stderr" stderr-string)) 46 | (when (non-empty-string? stderr-string) 47 | (raise-arguments-error (name run-command) 48 | "command exited successfully, but wrote to stderr" 49 | "command" (string-join (cons cmd-name stringified-args) " ") 50 | "stderr" stderr-string)) 51 | stdout-string) 52 | -------------------------------------------------------------------------------- /default-recommendations/syntax-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations syntax-shortcuts 5 | 6 | 7 | header: 8 | ------------------------------------------------------------------------------------------------------ 9 | #lang racket/base 10 | (require racket/syntax) 11 | ------------------------------------------------------------------------------------------------------ 12 | 13 | 14 | test: "syntax-e on a lone format-id argument is removable" 15 | - (format-id #'foo "~a/c" (syntax-e #'bar)) 16 | - (format-id #'foo "~a/c" #'bar) 17 | 18 | 19 | test: "syntax-e on multiple format-id arguments is removable" 20 | - (format-id #'foo "~a.~a.~a" (syntax-e #'bar) (syntax-e #'baz) (syntax-e #'blah)) 21 | - (format-id #'foo "~a.~a.~a" #'bar #'baz #'blah) 22 | 23 | 24 | test: "syntax-e on a single format-id argument is removable" 25 | - (format-id #'foo "~a.~a.~a" #'bar (syntax-e #'baz) #'blah) 26 | - (format-id #'foo "~a.~a.~a" #'bar #'baz #'blah) 27 | 28 | 29 | no-change-test: "format-id call without any syntax-e unwrapped arguments not refactorable" 30 | - (format-id #'foo "~a.~a.~a" #'bar #'baz #'blah) 31 | 32 | 33 | test: "making a symbol with format can be simplified to format-symbol" 34 | - (string->symbol (format "make-~a" "foo")) 35 | - (format-symbol "make-~a" "foo") 36 | 37 | 38 | test: "making a symbol with format from a symbol can be simplified to format-symbol" 39 | - (string->symbol (format "make-~a" (symbol->string 'foo))) 40 | - (format-symbol "make-~a" 'foo) 41 | 42 | 43 | test: "making a symbol with format from an identifier can be simplified to format-symbol" 44 | - (string->symbol (format "make-~a" (symbol->string (syntax-e #'foo)))) 45 | - (format-symbol "make-~a" #'foo) 46 | 47 | 48 | test: "making a symbol with format from a keyword can be simplified to format-symbol" 49 | - (string->symbol (format "make-~a" (keyword->string '#:foo))) 50 | - (format-symbol "make-~a" '#:foo) 51 | 52 | 53 | test: "making a symbol with format from a keyword syntax object can be simplified to format-symbol" 54 | - (string->symbol (format "make-~a" (keyword->string (syntax-e #'#:foo)))) 55 | - (format-symbol "make-~a" #'#:foo) 56 | -------------------------------------------------------------------------------- /default-recommendations/dict-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [dict-suggestions refactoring-suite?])) 10 | 11 | 12 | (require racket/dict 13 | racket/set 14 | resyntax/base 15 | resyntax/default-recommendations/analyzers/identifier-usage 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-literal-set simple-for-loops 23 | (for 24 | for* 25 | for/list 26 | for*/list 27 | for/vector 28 | for*/vector 29 | for/set 30 | for*/set 31 | for/sum 32 | for*/sum 33 | for/product 34 | for*/product 35 | for/and 36 | for*/and 37 | for/or 38 | for*/or 39 | for/first 40 | for*/first 41 | for/last 42 | for*/last 43 | for/hash 44 | for*/hash)) 45 | 46 | 47 | (define-refactoring-rule in-dict-to-in-dict-keys 48 | #:description "This `in-dict` can be replaced with `in-dict-keys` since the value is not used." 49 | #:analyzers (list identifier-usage-analyzer) 50 | #:literals (in-dict) 51 | (for-id:id (clause-before ... [(key:id value:id) (in-dict dict-expr)] clause-after ...) body ...) 52 | #:when ((literal-set->predicate simple-for-loops) (attribute for-id)) 53 | #:when (equal? (syntax-property #'value 'usage-count) 0) 54 | (for-id (clause-before ... [key (in-dict-keys dict-expr)] clause-after ...) body ...)) 55 | 56 | 57 | (define-refactoring-rule in-dict-to-in-dict-values 58 | #:description "This `in-dict` can be replaced with `in-dict-values` since the key is not used." 59 | #:analyzers (list identifier-usage-analyzer) 60 | #:literals (in-dict) 61 | (for-id:id (clause-before ... [(key:id value:id) (in-dict dict-expr)] clause-after ...) body ...) 62 | #:when ((literal-set->predicate simple-for-loops) (attribute for-id)) 63 | #:when (equal? (syntax-property #'key 'usage-count) 0) 64 | (for-id (clause-before ... [value (in-dict-values dict-expr)] clause-after ...) body ...)) 65 | 66 | 67 | (define-refactoring-suite dict-suggestions 68 | #:rules (in-dict-to-in-dict-keys 69 | in-dict-to-in-dict-values)) 70 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/let-replacement-comment-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations let-replacement 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "let binding with commented right-hand-side expression" 12 | ------------------------------ 13 | (define (f) 14 | (let ([x 15 | ;; The number one 16 | 1]) 17 | x)) 18 | ============================== 19 | (define (f) 20 | (define x 21 | ;; The number one 22 | 1) 23 | x) 24 | ------------------------------ 25 | 26 | test: "let binding with commented second clause" 27 | ------------------------------ 28 | (define (f) 29 | (let ([x 1] 30 | ;; The number two 31 | [y 2]) 32 | (+ x y))) 33 | ============================== 34 | (define (f) 35 | (define x 1) 36 | ;; The number two 37 | (define y 2) 38 | (+ x y)) 39 | ------------------------------ 40 | 41 | 42 | no-change-test: "let binding with commented first clause not refactorable (yet)" 43 | ------------------------------ 44 | (define (f) 45 | (let (;; The number one 46 | [x 1]) 47 | x)) 48 | ------------------------------ 49 | 50 | 51 | test: "let binding with commented first body form refactorable" 52 | ------------------------------ 53 | (define (f) 54 | (let ([x 1]) 55 | ;; Comment 56 | (void) 57 | x)) 58 | ============================== 59 | (define (f) 60 | (define x 1) 61 | ;; Comment 62 | (void) 63 | x) 64 | ------------------------------ 65 | 66 | 67 | test: "let binding with commented second body form refactorable" 68 | ------------------------------ 69 | (define (f) 70 | (let ([x 1]) 71 | (void) 72 | ;; Comment 73 | x)) 74 | ============================== 75 | (define (f) 76 | (define x 1) 77 | (void) 78 | ;; Comment 79 | x) 80 | ------------------------------ 81 | 82 | 83 | test: "let binding with comments before let form refactorable" 84 | ------------------------------ 85 | (define (f) 86 | ;; Comment 87 | (void) 88 | ;; Comment 89 | (let ([x 1]) 90 | x)) 91 | ============================== 92 | (define (f) 93 | ;; Comment 94 | (void) 95 | ;; Comment 96 | (define x 1) 97 | x) 98 | ------------------------------ 99 | -------------------------------------------------------------------------------- /default-recommendations/mutability-predicates-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations mutability-predicates 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require racket/contract/base 11 | racket/mutability) 12 | ------------------------------ 13 | 14 | 15 | test: "hash? and immutable? can be refactored to immutable-hash?" 16 | - (void (and/c hash? immutable?)) 17 | - (void (and/c immutable? hash?)) 18 | - (void immutable-hash?) 19 | 20 | 21 | test: "string? and immutable? can be refactored to immutable-string?" 22 | - (void (and/c string? immutable?)) 23 | - (void (and/c immutable? string?)) 24 | - (void immutable-string?) 25 | 26 | 27 | test: "bytes? and immutable? can be refactored to immutable-bytes?" 28 | - (void (and/c bytes? immutable?)) 29 | - (void (and/c immutable? bytes?)) 30 | - (void immutable-bytes?) 31 | 32 | 33 | test: "vector? and immutable? can be refactored to immutable-vector?" 34 | - (void (and/c vector? immutable?)) 35 | - (void (and/c immutable? vector?)) 36 | - (void immutable-vector?) 37 | 38 | 39 | test: "box? and immutable? can be refactored to immutable-box?" 40 | - (void (and/c box? immutable?)) 41 | - (void (and/c immutable? box?)) 42 | - (void immutable-box?) 43 | 44 | 45 | test: "hash? and (not/c immutable?) can be refactored to mutable-hash?" 46 | - (void (and/c hash? (not/c immutable?))) 47 | - (void (and/c (not/c immutable?) hash?)) 48 | - (void mutable-hash?) 49 | 50 | 51 | test: "string? and (not/c immutable?) can be refactored to mutable-string?" 52 | - (void (and/c string? (not/c immutable?))) 53 | - (void (and/c (not/c immutable?) string?)) 54 | - (void mutable-string?) 55 | 56 | 57 | test: "bytes? and (not/c immutable?) can be refactored to mutable-bytes?" 58 | - (void (and/c bytes? (not/c immutable?))) 59 | - (void (and/c (not/c immutable?) bytes?)) 60 | - (void mutable-bytes?) 61 | 62 | 63 | test: "vector? and (not/c immutable?) can be refactored to mutable-vector?" 64 | - (void (and/c vector? (not/c immutable?))) 65 | - (void (and/c (not/c immutable?) vector?)) 66 | - (void mutable-vector?) 67 | 68 | 69 | test: "box? and (not/c immutable?) can be refactored to mutable-box?" 70 | - (void (and/c box? (not/c immutable?))) 71 | - (void (and/c (not/c immutable?) box?)) 72 | - (void mutable-box?) 73 | 74 | 75 | -------------------------------------------------------------------------------- /.github/workflows/resyntax-submit-review.yml: -------------------------------------------------------------------------------- 1 | name: Resyntax Review Submission 2 | 3 | # The Resyntax integration is split into two workflows. See ./resyntax-analyze.yml for details about 4 | # why it works this way. 5 | 6 | on: 7 | workflow_run: 8 | workflows: ["Resyntax Analysis"] 9 | types: 10 | - completed 11 | 12 | jobs: 13 | review: 14 | runs-on: ubuntu-latest 15 | if: > 16 | ${{ github.event.workflow_run.event == 'pull_request' && 17 | github.event.workflow_run.conclusion == 'success' }} 18 | env: 19 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 20 | permissions: 21 | pull-requests: write 22 | 23 | steps: 24 | - name: Checkout code 25 | uses: actions/checkout@v5.0.0 26 | - name: Download Resyntax analysis 27 | # This uses a github script instead of the download-artifact action because 28 | # that action doesn't work for artifacts uploaded by other workflows. See 29 | # https://github.com/actions/download-artifact/issues/130 for more info. 30 | uses: actions/github-script@v7.0.1 31 | with: 32 | script: | 33 | var artifacts = await github.rest.actions.listWorkflowRunArtifacts({ 34 | owner: context.repo.owner, 35 | repo: context.repo.repo, 36 | run_id: ${{github.event.workflow_run.id }}, 37 | }); 38 | var matchArtifact = artifacts.data.artifacts.filter((artifact) => { 39 | return artifact.name == "resyntax-review" 40 | })[0]; 41 | var download = await github.rest.actions.downloadArtifact({ 42 | owner: context.repo.owner, 43 | repo: context.repo.repo, 44 | artifact_id: matchArtifact.id, 45 | archive_format: 'zip', 46 | }); 47 | var fs = require('fs'); 48 | fs.writeFileSync('${{github.workspace}}/resyntax-review.zip', Buffer.from(download.data)); 49 | - run: unzip resyntax-review.zip 50 | - name: Create pull request review 51 | uses: actions/github-script@v7.0.1 52 | with: 53 | github-token: ${{ secrets.GITHUB_TOKEN }} 54 | script: | 55 | var create_review_request = require('./resyntax-review.json'); 56 | await github.rest.pulls.createReview(create_review_request); 57 | -------------------------------------------------------------------------------- /default-recommendations/class-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [class-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require racket/class 13 | resyntax/base 14 | syntax/parse) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | (define-syntax-class manual-method-chain 21 | #:attributes (initial-object [method 1] [arg 2]) 22 | #:literals (send) 23 | 24 | (pattern (send inner-chain:manual-method-chain last-method:id last-method-arg ...) 25 | #:attr initial-object (attribute inner-chain.initial-object) 26 | #:attr [method 1] (append (attribute inner-chain.method) (list #'last-method)) 27 | #:attr [arg 2] (append (attribute inner-chain.arg) (list (attribute last-method-arg)))) 28 | 29 | (pattern (send (~and initial-object (~not _:manual-method-chain)) 30 | first-method:id 31 | first-method-arg ...) 32 | #:attr [method 1] (list #'first-method) 33 | #:attr [arg 2] (list (attribute first-method-arg)))) 34 | 35 | 36 | (define-refactoring-rule send-chain-to-send+ 37 | #:description 38 | "This method chain made of nested `send` expressions can be written more clearly as a `send+`\ 39 | expression." 40 | chain:manual-method-chain 41 | #:when (>= (length (attribute chain.method)) 3) 42 | (send+ chain.initial-object (chain.method chain.arg ...) ...)) 43 | 44 | 45 | (define-refactoring-rule instantiate-to-make-object 46 | #:description "The `instantiate` form is for mixing positional and by-name constructor arguments.\ 47 | When no by-name arguments are needed, use `make-object` instead." 48 | #:literals (instantiate) 49 | (instantiate cls (by-position-arg ...+)) 50 | (make-object cls by-position-arg ...)) 51 | 52 | 53 | (define-refactoring-rule instantiate-to-new 54 | #:description "The `instantiate` form is for mixing positional and by-name constructor arguments.\ 55 | When no positional arguments are needed, use `new` instead." 56 | #:literals (instantiate) 57 | (instantiate cls () by-name-arg ...+) 58 | (new cls by-name-arg ...)) 59 | 60 | 61 | (define-refactoring-suite class-shortcuts 62 | #:rules (instantiate-to-make-object 63 | instantiate-to-new 64 | send-chain-to-send+)) 65 | -------------------------------------------------------------------------------- /private/more-syntax-parse-classes.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide syntax-parse-option 5 | syntax-parse-pattern-directive) 6 | 7 | 8 | (require syntax/parse) 9 | 10 | 11 | ;@---------------------------------------------------------------------------------------------------- 12 | 13 | 14 | (define-splicing-syntax-class syntax-parse-option 15 | (pattern (~seq #:context ~! context-expr:expr)) 16 | (pattern (~seq #:literals ~! (literal:syntax-parse-literal ...))) 17 | (pattern (~seq #:datum-literals ~! (datum-literal:syntax-parse-datum-literal ...))) 18 | (pattern (~seq #:literal-sets ~! (literal-set:syntax-parse-literal-set ...))) 19 | (pattern #:track-literals) 20 | (pattern (~seq #:conventions ~! (convention-id:id ...))) 21 | (pattern (~seq #:local-conventions ~! (convention-id:id ...))) 22 | (pattern #:disable-colon-notation)) 23 | 24 | 25 | (define-syntax-class syntax-parse-literal 26 | (pattern literal-id:id) 27 | (pattern (pattern-id:id literal-id:id)) 28 | (pattern (pattern-id:id literal-id:id #:phase phase-expr:expr))) 29 | 30 | 31 | (define-syntax-class syntax-parse-datum-literal 32 | (pattern literal-id:id) 33 | (pattern (pattern-id:id literal-id:id))) 34 | 35 | 36 | (define-syntax-class syntax-parse-literal-set 37 | (pattern literal-set-id:id) 38 | (pattern (literal-set-id:id literal-set-option:syntax-parse-literal-set-option ...))) 39 | 40 | 41 | (define-splicing-syntax-class syntax-parse-literal-set-option 42 | (pattern (~seq #:at context-id:id)) 43 | (pattern (~seq #:phase phase-expr:expr))) 44 | 45 | 46 | (define-splicing-syntax-class syntax-parse-pattern-directive 47 | (pattern (~seq #:declare ~! pvar-id:id 48 | (~or syntax-class-id:id (syntax-class-id:id arg ...)) 49 | (~optional (~seq #:role role-expr:expr)))) 50 | (pattern (~seq #:post ~! action-pattern)) 51 | (pattern (~seq #:and ~! action-pattern)) 52 | (pattern (~seq #:with ~! syntax-pattern stx-expr:expr)) 53 | (pattern (~seq #:attr ~! (~or attr-name-id:id (attr-name-id:id depth)) expr:expr)) 54 | (pattern (~seq #:fail-when ~! condition-expr:expr message-expr:expr)) 55 | (pattern (~seq #:fail-unless ~! condition-expr:expr message-expr:expr)) 56 | (pattern (~seq #:when ~! condition-expr:expr)) 57 | (pattern (~seq #:do ~! [defn-or-expr ...])) 58 | (pattern (~seq #:undo ~! [defn-or-expr ...])) 59 | (pattern #:cut)) 60 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/cond-let-replacement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [cond-let-replacement refactoring-suite?])) 10 | 11 | 12 | (require racket/list 13 | resyntax/base 14 | resyntax/default-recommendations/let-replacement/private/let-binding 15 | resyntax/default-recommendations/private/if-arm 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-syntax-class let-refactorable-cond-clause 23 | #:attributes (refactored) 24 | (pattern [condition:expr leading-body ... let-expr:refactorable-let-expression] 25 | #:with refactored 26 | #`(~replacement 27 | [condition leading-body ... (~@ . (~focus-replacement-on (let-expr.refactored ...)))] 28 | #:original #,this-syntax))) 29 | 30 | 31 | (define-refactoring-rule cond-let-to-cond-define 32 | #:description 33 | "Internal definitions are recommended instead of `let` expressions, to reduce nesting." 34 | #:literals (cond) 35 | (cond-id:cond clause-before ... clause:let-refactorable-cond-clause clause-after ...) 36 | (cond-id clause-before ... clause.refactored clause-after ...)) 37 | 38 | 39 | (define-refactoring-rule if-let-to-cond 40 | #:description 41 | "`cond` with internal definitions is preferred over `if` with `let`, to reduce nesting" 42 | #:literals (if void) 43 | (if condition 44 | (~and then-expr:if-arm (~not (void))) 45 | (~and else-expr:if-arm (~not (void)))) 46 | #:when (or (attribute then-expr.uses-let?) (attribute else-expr.uses-let?)) 47 | (cond (~replacement [condition then-expr.refactored ...] #:original-splice (condition then-expr)) 48 | (~replacement [else else-expr.refactored ...] #:original else-expr))) 49 | 50 | 51 | (define-refactoring-rule and-let-to-cond 52 | #:description 53 | "Using `cond` allows converting `let` to internal definitions, reducing nesting" 54 | #:literals (and cond) 55 | (and condition let-expr:refactorable-let-expression) 56 | #:when (not (empty? (attribute let-expr.id))) 57 | (cond [condition let-expr.refactored ...] 58 | [else #false])) 59 | 60 | 61 | (define-refactoring-suite cond-let-replacement 62 | #:rules (and-let-to-cond 63 | cond-let-to-cond-define 64 | if-let-to-cond)) 65 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/new-rule-request.yaml: -------------------------------------------------------------------------------- 1 | name: New rule request 2 | description: Suggest adding a new refactoring rule to Resyntax's default recommendations 3 | title: "New rule: `rule-name-here`" 4 | labels: new lint 5 | body: 6 | - type: textarea 7 | attributes: 8 | label: Rule summary 9 | description: Describe the rule you'd like to see added to Resyntax, keeping in mind [what makes a good refactoring rule](https://docs.racket-lang.org/resyntax/Refactoring_Rules_and_Suites.html#%28part._.What_.Makes_a_.Good_.Refactoring_.Rule_%29). 10 | placeholder: The expression `(foo (list a b c))` can be written more simply as `(foo a b c)`. Resyntax should suggest rewriting the first form to the second. 11 | validations: 12 | required: true 13 | - type: textarea 14 | attributes: 15 | label: Test case 16 | description: Write a [Resyntax test case](https://docs.racket-lang.org/resyntax/Testing_Refactoring_Rules.html) demonstrating how this rule should transform code. 17 | value: | 18 | #lang resyntax/test 19 | 20 | test: "original code should be refactorable to new code" 21 | -------------------- 22 | #lang racket 23 | ;; Put the original code here 24 | ==================== 25 | #lang racket 26 | ;; Put the code you'd like Resyntax to generate here 27 | -------------------- 28 | render: scheme 29 | validations: 30 | required: true 31 | - type: textarea 32 | attributes: 33 | label: No-change test case 34 | description: If there's an important case where this rule should *not* be applied, write a [no-change test case](https://docs.racket-lang.org/resyntax/Testing_Refactoring_Rules.html#%28form._%28%28lib._resyntax%2Ftest..rkt%29._no-change-test~3a%29%29) for it. 35 | value: | 36 | #lang resyntax/test 37 | 38 | no-change-test: "code not refactorable" 39 | -------------------- 40 | #lang racket 41 | ;; Put the code which Resyntax shouldn't refactor here 42 | -------------------- 43 | render: scheme 44 | validations: 45 | required: false 46 | - type: textarea 47 | attributes: 48 | label: Additional context 49 | description: If applicable, include links to publicly viewable code where this rule would help. 50 | placeholder: The code in octocat/neat-project#123 would be improved by this, especially [this file](https://example.com). 51 | validations: 52 | required: false 53 | -------------------------------------------------------------------------------- /default-recommendations/function-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [function-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | rebellion/private/static-name 14 | resyntax/base 15 | resyntax/default-recommendations/private/literal-constant 16 | resyntax/private/syntax-replacement 17 | syntax/parse) 18 | 19 | 20 | ;@---------------------------------------------------------------------------------------------------- 21 | 22 | 23 | (define-syntax-class unquoted 24 | #:attributes (expr) 25 | #:literals (unquote) 26 | (pattern expr:literal-constant) 27 | (pattern (unquote expr:expr))) 28 | 29 | 30 | (define-syntax-class trailing-list-argument 31 | #:attributes ([lifted 1] trailing) 32 | #:literals (cons list* quasiquote unquote-splicing) 33 | 34 | (pattern (cons arg rest:trailing-list-argument) 35 | #:cut 36 | #:with (lifted ...) #'(arg rest.lifted ...) 37 | #:with trailing #'rest.trailing) 38 | 39 | (pattern (cons arg trailing:expr) 40 | #:cut 41 | #:with (lifted ...) #'(arg)) 42 | 43 | (pattern (list* arg ... rest:trailing-list-argument) 44 | #:cut 45 | #:with (lifted ...) #'(arg ... rest.lifted ...) 46 | #:with trailing #'rest.trailing) 47 | 48 | (pattern (list* arg ... rest:expr) 49 | #:cut 50 | #:with (lifted ...) #'(arg ...) 51 | #:with trailing #'rest) 52 | 53 | (pattern (quasiquote (arg:unquoted ... (unquote-splicing rest))) 54 | #:cut 55 | #:with (lifted ...) #'(arg.expr ...) 56 | #:with trailing #'rest)) 57 | 58 | 59 | (define-refactoring-rule apply-flattening 60 | #:description 61 | "The `apply` function accepts single arguments in addition to a trailing list argument." 62 | #:literals (apply) 63 | ((~and id apply) function:expr arg ... trailing-arg:trailing-list-argument) 64 | (id function arg ... trailing-arg.lifted ... trailing-arg.trailing)) 65 | 66 | 67 | (define-refactoring-rule case-lambda-with-single-case-to-lambda 68 | #:description "This `case-lambda` form only has one case. Use a regular lambda instead." 69 | #:literals (case-lambda) 70 | (case-lambda [args body ...]) 71 | (λ args body ...)) 72 | 73 | 74 | (define-refactoring-suite function-shortcuts 75 | #:rules (apply-flattening 76 | case-lambda-with-single-case-to-lambda)) 77 | -------------------------------------------------------------------------------- /default-recommendations/legacy/make-temporary-directory-migration.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [make-temporary-directory-migration refactoring-suite?])) 10 | 11 | 12 | (require racket/file 13 | racket/list 14 | rebellion/private/static-name 15 | resyntax/base 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-splicing-syntax-class function-call-argument 23 | #:attributes (keyword expr) 24 | (pattern (~seq expr:expr) #:attr keyword #false) 25 | (pattern (~seq keyword:keyword expr:expr))) 26 | 27 | 28 | (define-splicing-syntax-class function-call-arguments 29 | #:attributes ([positional 1] keyword) 30 | (pattern (~seq arg:function-call-argument ...) 31 | #:cut 32 | #:with (positional ...) 33 | (for/list ([expr (in-list (attribute arg.expr))] 34 | [keyword (in-list (attribute arg.keyword))] 35 | #:unless keyword) 36 | expr) 37 | 38 | #:attr keyword 39 | (for/hasheq ([expr (in-list (attribute arg.expr))] 40 | [keyword (in-list (attribute arg.keyword))] 41 | #:when keyword) 42 | (values (syntax-e keyword) expr)))) 43 | 44 | 45 | (define-refactoring-rule make-temporary-file-to-make-temporary-directory 46 | #:description "Use `make-temporary-directory` to make directories instead of `make-temporary-file`." 47 | #:literals (make-temporary-file) 48 | #:datum-literals (quote directory) 49 | 50 | (make-temporary-file args:function-call-arguments) 51 | #:with 'directory 52 | (or (and (>= (length (attribute args.positional)) 2) 53 | (second (attribute args.positional))) 54 | (hash-ref (attribute args.keyword) '#:copy-from #false)) 55 | #:cut 56 | #:attr template-arg 57 | (and (not (empty? (attribute args.positional))) 58 | (first (attribute args.positional))) 59 | #:attr base-dir-arg 60 | (or (and (>= (length (attribute args.positional)) 3) 61 | (third (attribute args.positional))) 62 | (hash-ref (attribute args.keyword) '#:base-dir #false)) 63 | 64 | (make-temporary-directory (~? template-arg) (~? (~@ #:base-dir base-dir-arg)))) 65 | 66 | 67 | (define-refactoring-suite make-temporary-directory-migration 68 | #:rules (make-temporary-file-to-make-temporary-directory)) 69 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/function-expression-analyzer.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [function-expression-analyzer expansion-analyzer?])) 10 | 11 | 12 | (require racket/stream 13 | rebellion/streaming/transducer 14 | resyntax/private/analyzer 15 | resyntax/private/syntax-path 16 | resyntax/private/syntax-property-bundle 17 | resyntax/private/syntax-traversal 18 | syntax/parse) 19 | 20 | 21 | ;@---------------------------------------------------------------------------------------------------- 22 | 23 | 24 | (define (annotate-application-subexpressions expanded-stx) 25 | (let loop ([expanded-stx expanded-stx] [phase 0]) 26 | (syntax-search expanded-stx 27 | #:literal-sets ([kernel-literals #:phase phase]) 28 | 29 | ;; Phase mismatch - recurse with correct phase 30 | [(id:id _ ...) 31 | #:do [(define id-phase (syntax-property (attribute id) 'phase))] 32 | #:when (not (equal? id-phase phase)) 33 | (loop this-syntax id-phase)] 34 | 35 | ;; Skip quote-syntax - no function applications inside 36 | [(quote-syntax _) (stream)] 37 | 38 | ;; Function application - annotate function and arguments 39 | ;; Note: In fully expanded code, we need to match #%plain-app using identifier comparison 40 | [(app-id:id func arg ...) 41 | #:when (free-identifier=? (attribute app-id) #'#%plain-app) 42 | #:do [(define func-path (syntax-property (attribute func) 'expansion-path))] 43 | #:when func-path 44 | (define func-entry (syntax-property-entry func-path 'application-subexpression-kind 'function)) 45 | (define arg-entries 46 | (for/stream ([arg-stx (in-list (attribute arg))]) 47 | (define arg-path (syntax-property arg-stx 'expansion-path)) 48 | (and arg-path 49 | (syntax-property-entry arg-path 'application-subexpression-kind 'argument)))) 50 | (stream-cons func-entry (stream-filter values arg-entries))]))) 51 | 52 | 53 | (define function-expression-analyzer 54 | (make-expansion-analyzer 55 | #:name 'function-expression-analyzer 56 | (λ (expanded-stx) 57 | (define labeled-stx (syntax-label-paths expanded-stx 'expansion-path)) 58 | (transduce (annotate-application-subexpressions labeled-stx) 59 | #:into into-syntax-property-bundle)))) 60 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/ignored-result-values-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | require: resyntax/default-recommendations/analyzers/ignored-result-values ignored-result-values-analyzer 3 | header: - #lang racket/base 4 | 5 | 6 | analysis-test: "non-terminal function bodies are ignored" 7 | -------------------- 8 | (define (f) 9 | (displayln "hi") 10 | (void)) 11 | -------------------- 12 | @inspect - (displayln "hi") 13 | @property expression-result 14 | @assert ignored 15 | 16 | 17 | analysis-test: "terminal function bodies are used" 18 | -------------------- 19 | (define (f) 20 | (displayln "hi") 21 | (void)) 22 | -------------------- 23 | @inspect - (void) 24 | @property expression-result 25 | @assert used 26 | 27 | 28 | analysis-test: "function arguments are used" 29 | - (list (void)) 30 | @inspect - (void) 31 | @property expression-result 32 | @assert used 33 | 34 | 35 | analysis-test: "applied functions are used" 36 | - (list (void)) 37 | @inspect - list 38 | @property expression-result 39 | @assert used 40 | 41 | 42 | analysis-test: "variable definitions use their right hand side" 43 | - (define a (void)) 44 | @inspect - (void) 45 | @property expression-result 46 | @assert used 47 | 48 | 49 | analysis-test: "syntax definitions use their right hand side" 50 | -------------------- 51 | (require (for-syntax racket/base)) 52 | (define-syntax a (void)) 53 | -------------------- 54 | @inspect - (void) 55 | @property expression-result 56 | @assert used 57 | 58 | 59 | analysis-test: "begin0 forms use their initial expression" 60 | -------------------- 61 | (begin0 (void) 62 | (displayln "after")) 63 | -------------------- 64 | @inspect - (void) 65 | @property expression-result 66 | @assert used 67 | 68 | 69 | analysis-test: "begin0 forms ignore their trailing body" 70 | -------------------- 71 | (begin0 (void) 72 | (displayln "after")) 73 | -------------------- 74 | @inspect - (displayln "after") 75 | @property expression-result 76 | @assert ignored 77 | 78 | 79 | analysis-test: "let expressions ignore their non-terminal body forms" 80 | -------------------- 81 | (let () 82 | (displayln "hi") 83 | (void)) 84 | -------------------- 85 | @inspect - (displayln "hi") 86 | @property expression-result 87 | @assert ignored 88 | 89 | 90 | analysis-test: "let expressions use their terminal body form" 91 | -------------------- 92 | (let () 93 | (displayln "hi") 94 | (void)) 95 | -------------------- 96 | @inspect - (void) 97 | @property expression-result 98 | @assert used 99 | -------------------------------------------------------------------------------- /default-recommendations/loops/private/syntax-classes.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide worthwhile-loop-body-function) 5 | 6 | 7 | (require resyntax/default-recommendations/private/lambda-by-any-name 8 | resyntax/default-recommendations/let-replacement/private/let-binding 9 | syntax/parse) 10 | 11 | 12 | ;@---------------------------------------------------------------------------------------------------- 13 | 14 | 15 | ;; A loop body function is a lambda expression that is passed to a function like map, for-each, or 16 | ;; ormap which calls the lambda once for each element of a list. When code is migrated to use for 17 | ;; loops, the loop body function becomes the body of the for loop, hence the name. For convenience, 18 | ;; we also accept lambdas which take two arguments such as those used with hash-for-each. Techncially, 19 | ;; such a two-argument lambda shouldn't be accepted when in the context of a function like for-each 20 | ;; instead of hash-for-each, but we don't bother checking for that since if the code already compiles 21 | ;; and runs without any tests failing it probably doesn't have that issue. 22 | (define-syntax-class worthwhile-loop-body-function 23 | #:attributes (x y [body 1]) 24 | 25 | ;; We always migrate loop functions that use let expressions, since in the process of migrating 26 | ;; we can replace the let bindings with internal definitions within the for loop body. 27 | (pattern 28 | (_:lambda-by-any-name (x (~optional (~seq y))) 29 | original-body:body-with-refactorable-let-expression) 30 | #:with (body ...) #'(original-body.refactored ...)) 31 | 32 | ;; Lambdas with multiple body forms are hard to read when all the forms are on one line, so we 33 | ;; assume all such lambdas are multi-line, and multi-line for-each functions are typically easier 34 | ;; to read when they're in the body of a for loop. 35 | (pattern (_:lambda-by-any-name (x (~optional (~seq y))) first-body remaining-body ...+) 36 | #:with (body ...) #'(first-body remaining-body ...)) 37 | 38 | ;; We don't bother migrating for-each forms with only a single body form unless the body form is 39 | ;; exceptionally long, so that forms which span multiple lines tend to get migrated. By not 40 | ;; migrating short forms, we avoid bothering reviewers with changes to loops that aren't complex 41 | ;; enough to need a lot of refactoring in the first place. 42 | (pattern (_:lambda-by-any-name (x (~optional (~seq y))) only-body) 43 | #:when (>= (syntax-span #'only-body) 60) 44 | #:with (body ...) #'(only-body))) 45 | -------------------------------------------------------------------------------- /default-recommendations/private/syntax-equivalence.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [syntax-free-identifier=? (-> syntax? syntax? boolean?)])) 10 | 11 | 12 | (require guard 13 | racket/list 14 | racket/match) 15 | 16 | 17 | (module+ test 18 | (require rackunit 19 | (submod ".."))) 20 | 21 | 22 | ;@---------------------------------------------------------------------------------------------------- 23 | 24 | 25 | (define (syntax-free-identifier=? stx other-stx) 26 | (define datum (syntax-e stx)) 27 | (define other-datum (syntax-e other-stx)) 28 | (match datum 29 | [(? symbol?) (and (symbol? other-datum) (free-identifier=? stx other-stx))] 30 | [(or (? number?) (? boolean?) (? string?)) (equal? datum other-datum)] 31 | [(? list?) (and (list? other-datum) (syntax-pair-free-identifier=? datum other-datum))] 32 | [(? box?) (and (box? other-datum) (syntax-free-identifier=? (unbox datum) (unbox other-datum)))] 33 | [(? vector?) 34 | (and (equal? (vector-length datum) (vector-length other-datum)) 35 | (for/and ([substx (in-vector datum)] [other-substx (in-vector other-datum)]) 36 | (syntax-free-identifier=? substx other-substx)))] 37 | [_ (error 'syntax-free-identifier=? "hash datum comparisons not implemented yet.")])) 38 | 39 | 40 | (define (syntax-pair-free-identifier=? pair other-pair) 41 | (match pair 42 | ['() (empty? other-pair)] 43 | [(cons head (? syntax? tail)) 44 | (match other-pair 45 | [(cons other-head (? syntax? other-tail)) 46 | (and (syntax-free-identifier=? head other-head) 47 | (syntax-free-identifier=? tail other-tail))] 48 | [_ #false])] 49 | [(cons head tail) 50 | (match other-pair 51 | [(cons other-head other-tail) 52 | (and (syntax-free-identifier=? head other-head) 53 | (syntax-pair-free-identifier=? tail other-tail))] 54 | [_ #false])])) 55 | 56 | 57 | (module+ test 58 | (test-case "syntax-free-identifier=?" 59 | (check-true (syntax-free-identifier=? #'5 #'5)) 60 | (check-false (syntax-free-identifier=? #'5 #'7)) 61 | (check-false (syntax-free-identifier=? #'5 #'x)) 62 | (check-true (syntax-free-identifier=? #'x #'x)) 63 | (check-true (syntax-free-identifier=? #'(x y z) #'(x y z))) 64 | (check-false (syntax-free-identifier=? #'(x y z) #'(x y))) 65 | (check-true (syntax-free-identifier=? #'(x (y) z) #'(x (y) z))) 66 | (check-false (syntax-free-identifier=? #'(x (y) z) #'(x y z))))) 67 | -------------------------------------------------------------------------------- /default-recommendations/contract-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [contract-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | rebellion/private/static-name 14 | resyntax/base 15 | resyntax/default-recommendations/private/syntax-lines 16 | resyntax/default-recommendations/private/syntax-tree 17 | resyntax/private/syntax-replacement 18 | syntax/parse) 19 | 20 | 21 | ;@---------------------------------------------------------------------------------------------------- 22 | 23 | 24 | (define-refactoring-rule nested-or/c-to-flat-or/c 25 | #:description "Nested `or/c` contracts can be flattened to a single, equivalent `or/c` contract." 26 | (~var or-tree (syntax-tree #'or/c)) 27 | ;; Restricted to single-line expressions for now because the syntax-tree operations don't preserve 28 | ;; any formatting between adjacent leaves. 29 | #:when (oneline-syntax? #'or-tree) 30 | #:when (>= (attribute or-tree.rank) 2) 31 | (or/c or-tree.leaf ...)) 32 | 33 | 34 | (define-refactoring-rule nested-and/c-to-flat-and/c 35 | #:description "Nested `and/c` contracts can be flattened to a single, equivalent `and/c` contract." 36 | (~var and-tree (syntax-tree #'and/c)) 37 | ;; Restricted to single-line expressions for now because the syntax-tree operations don't preserve 38 | ;; any formatting between adjacent leaves. 39 | #:when (oneline-syntax? #'and-tree) 40 | #:when (>= (attribute and-tree.rank) 2) 41 | (and/c and-tree.leaf ...)) 42 | 43 | 44 | (define-refactoring-rule explicit-path-string?-to-path-string? 45 | #:description "This contract is equivalent to the `path-string?` predicate." 46 | #:literals (or/c path? string?) 47 | (~or (or/c path? string?) (or/c string? path?)) 48 | path-string?) 49 | 50 | 51 | (define-refactoring-rule arrow-contract-with-rest-to-arrow-contract-with-ellipses 52 | #:description "This `->*` contract can be rewritten using `->` with ellipses." 53 | #:literals (->* listof) 54 | (->* (arg-contract ...) 55 | (~optional ()) 56 | #:rest (~and rest-list (listof rest-contract)) 57 | result-contract) 58 | (-> arg-contract ... 59 | rest-contract (... ...) 60 | result-contract)) 61 | 62 | 63 | (define-refactoring-suite contract-shortcuts 64 | #:rules (arrow-contract-with-rest-to-arrow-contract-with-ellipses 65 | explicit-path-string?-to-path-string? 66 | nested-or/c-to-flat-or/c 67 | nested-and/c-to-flat-and/c)) 68 | -------------------------------------------------------------------------------- /default-recommendations/comment-preservation-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations let-replacement 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "expression comments are preserved between let bindings" 12 | ------------------------------ 13 | (define (foo) 14 | (let ([x 1] 15 | #;(debug-binding [z 0]) 16 | [y 2]) 17 | (+ x y))) 18 | ============================== 19 | (define (foo) 20 | (define x 1) 21 | #;(debug-binding [z 0]) 22 | (define y 2) 23 | (+ x y)) 24 | ------------------------------ 25 | 26 | 27 | test: "expression comments with atoms are preserved between let bindings" 28 | ------------------------------ 29 | (define (foo) 30 | (let ([x 1] 31 | #;unused-binding 32 | [y 2]) 33 | (+ x y))) 34 | ============================== 35 | (define (foo) 36 | (define x 1) 37 | #;unused-binding 38 | (define y 2) 39 | (+ x y)) 40 | ------------------------------ 41 | 42 | 43 | test: "block comments are preserved between let bindings" 44 | ------------------------------ 45 | (define (foo) 46 | (let ([x 1] 47 | #| The second 48 | binding |# 49 | [y 2]) 50 | (+ x y))) 51 | ============================== 52 | (define (foo) 53 | (define x 1) 54 | #| The second 55 | binding |# 56 | (define y 2) 57 | (+ x y)) 58 | ------------------------------ 59 | 60 | 61 | test: "expression comments with nested sexps are preserved" 62 | ------------------------------ 63 | (define (foo) 64 | (let ([x 1] 65 | #;(commented-binding 66 | [y 3] 67 | [z 4]) 68 | [a 2]) 69 | (+ x a))) 70 | ============================== 71 | (define (foo) 72 | (define x 1) 73 | #;(commented-binding [y 3] [z 4]) 74 | (define a 2) 75 | (+ x a)) 76 | ------------------------------ 77 | 78 | 79 | test: "expression comments in let body are preserved" 80 | ------------------------------ 81 | (define (foo) 82 | (let ([x 1]) 83 | #;(debug-stmt) 84 | (+ x 1))) 85 | ============================== 86 | (define (foo) 87 | (define x 1) 88 | #;(debug-stmt) 89 | (+ x 1)) 90 | ------------------------------ 91 | 92 | 93 | test: "block comments in let body are preserved" 94 | ------------------------------ 95 | (define (foo) 96 | (let ([x 1]) 97 | #| computation |# 98 | (+ x 1))) 99 | ============================== 100 | (define (foo) 101 | (define x 1) 102 | #| computation |# 103 | (+ x 1)) 104 | ------------------------------ 105 | -------------------------------------------------------------------------------- /default-recommendations/syntax-parse-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [syntax-parse-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base 13 | syntax/parse) 14 | rebellion/private/static-name 15 | resyntax/base 16 | resyntax/private/more-syntax-parse-classes 17 | resyntax/private/syntax-traversal 18 | racket/stream 19 | syntax/parse 20 | syntax/parse/define) 21 | 22 | 23 | ;@---------------------------------------------------------------------------------------------------- 24 | 25 | 26 | (define-refactoring-rule define-syntax-syntax-parse-to-define-syntax-parse-rule 27 | #:description 28 | "This `define-syntax` macro with a single `syntax-parse` clause can be replaced with a simpler, 29 | equivalent `define-syntax-parse-rule` macro." 30 | #:literals (define-syntax lambda [syntax-parse syntax-parse #:phase 1] [syntax-id syntax #:phase 1]) 31 | 32 | (define-syntax macro:id 33 | (lambda (stx-id:id) 34 | (syntax-parse stx-id2:id 35 | [(_ pattern ...) directive:syntax-parse-pattern-directive ... (syntax-id last-form)]))) 36 | 37 | #:when (free-identifier=? (attribute stx-id) (attribute stx-id2) 1) 38 | 39 | #:with (new-body ...) 40 | (syntax-traverse #'((~@ . directive) ... last-form) 41 | [id-in-body:id 42 | #:when (free-identifier=? (attribute id-in-body) (attribute stx-id) 1) 43 | (syntax-property #'this-syntax 'skip-incorrect-binding-check? #true)]) 44 | 45 | (define-syntax-parse-rule (macro pattern ...) new-body ...)) 46 | 47 | 48 | (define-refactoring-rule define-syntax-parser-to-define-syntax-parse-rule-simple 49 | #:description 50 | "This `define-syntax-parser` macro with a single clause can be replaced with a simpler, equivalent 51 | `define-syntax-parse-rule` macro." 52 | #:literals (define-syntax-parser) 53 | 54 | (define-syntax-parser macro:id 55 | [(_ . pattern) body ...]) 56 | 57 | #:do [(define (strip-syntax-wrapper stx) 58 | (syntax-parse stx 59 | #:literals (syntax) 60 | [(syntax body) #'body] 61 | [other #'other])) 62 | (define new-body (map strip-syntax-wrapper (attribute body)))] 63 | 64 | #:with (new-body-part ...) new-body 65 | 66 | (define-syntax-parse-rule (macro . pattern) new-body-part ...)) 67 | 68 | 69 | (define-refactoring-suite syntax-parse-shortcuts 70 | #:rules (define-syntax-syntax-parse-to-define-syntax-parse-rule 71 | define-syntax-parser-to-define-syntax-parse-rule-simple)) 72 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/match-let-replacement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [match-let-replacement refactoring-suite?])) 10 | 11 | 12 | (require racket/list 13 | racket/match 14 | racket/set 15 | resyntax/base 16 | resyntax/default-recommendations/private/syntax-identifier-sets 17 | resyntax/private/syntax-replacement 18 | syntax/parse 19 | syntax/strip-context) 20 | 21 | 22 | ;@---------------------------------------------------------------------------------------------------- 23 | 24 | 25 | (define-syntax-class single-binding-match-let 26 | #:literals (match-let match-let* match-letrec) 27 | #:attributes (match-pattern subject [body 1] [as-definition-context-body 1]) 28 | 29 | (pattern ((~or match-let match-let* match-letrec) ([match-pattern subject]) body ...) 30 | #:with definition #'(match-define match-pattern subject) 31 | #:with (as-definition-context-body ...) 32 | #`(~splicing-replacement (definition body ...) #:original #,this-syntax))) 33 | 34 | 35 | (define-definition-context-refactoring-rule match-let-to-match-define 36 | #:description 37 | "Internal definitions are recommended instead of `match-let` expressions with a single binding, to\ 38 | reduce nesting." 39 | #:literals (match-let match-let* match-letrec) 40 | (~seq body-before ... match-let-expression:single-binding-match-let) 41 | 42 | #:do 43 | [(define pattern-ids 44 | (syntax-bound-identifiers (attribute match-let-expression.match-pattern))) 45 | (define pattern-ids-in-surrounding-context 46 | (syntax-bound-identifiers 47 | (replace-context (attribute match-let-expression) (attribute match-let-expression.match-pattern)))) 48 | (define body-ids (syntax-bound-identifiers #'(body-before ... match-let-expression.subject))) 49 | (define subject-ids-in-body-context 50 | (syntax-bound-identifiers 51 | (replace-context 52 | (first (attribute match-let-expression.body)) (attribute match-let-expression.subject))))] 53 | #:when (set-empty? (set-intersect pattern-ids-in-surrounding-context body-ids)) 54 | #:when (set-empty? (set-intersect pattern-ids subject-ids-in-body-context)) 55 | #:with (new-body ...) 56 | (if (empty? (attribute body-before)) 57 | (attribute match-let-expression.as-definition-context-body) 58 | #'(~focus-replacement-on 59 | (match-let-expression.as-definition-context-body ...))) 60 | 61 | (body-before ... new-body ...)) 62 | 63 | 64 | (define-refactoring-suite match-let-replacement 65 | #:rules (match-let-to-match-define)) 66 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/argument-let-replacement-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations argument-let-replacement 5 | 6 | 7 | header: 8 | -------------------- 9 | #lang racket 10 | (define (g x y) 11 | (+ x y)) 12 | -------------------- 13 | 14 | 15 | test: "let in function argument can be extracted" 16 | -------------------- 17 | (define (f) 18 | (g (let ([x 42]) 19 | (* x 2)) 20 | (let ([y 100]) 21 | (* y 3)))) 22 | ==================== 23 | (define (f) 24 | (define x 42) 25 | (define y 100) 26 | (g (* x 2) (* y 3))) 27 | -------------------- 28 | 29 | 30 | test: "single let in function argument can be extracted" 31 | -------------------- 32 | (define (f) 33 | (list (let ([x 10]) 34 | (+ x 5)))) 35 | ==================== 36 | (define (f) 37 | (define x 10) 38 | (list (+ x 5))) 39 | -------------------- 40 | 41 | 42 | test: "multiple bindings in single let can be extracted" 43 | -------------------- 44 | (define (f) 45 | (g (let ([x 1] 46 | [y 2]) 47 | (+ x y)))) 48 | ==================== 49 | (define (f) 50 | (define x 1) 51 | (define y 2) 52 | (g (+ x y))) 53 | -------------------- 54 | 55 | 56 | test: "let in one argument while other arguments are plain" 57 | -------------------- 58 | (define (f) 59 | (cons (let ([x 42]) 60 | (* x 2)) 61 | 100)) 62 | ==================== 63 | (define (f) 64 | (define x 42) 65 | (cons (* x 2) 100)) 66 | -------------------- 67 | 68 | 69 | test: "nested lets in same argument are extracted" 70 | -------------------- 71 | (define (f) 72 | (list (let ([x 1]) 73 | (let ([y 2]) 74 | (+ x y))))) 75 | ==================== 76 | (define (f) 77 | (define x 1) 78 | (define y 2) 79 | (list (+ x y))) 80 | -------------------- 81 | 82 | 83 | no-change-test: "lets after side-effectful expressions not extracted" 84 | -------------------- 85 | (define (f) 86 | (list (displayln "foo") 87 | (let ([x 1]) 88 | (* x 2)))) 89 | -------------------- 90 | 91 | 92 | no-change-test: "lets after error expressions not extracted" 93 | -------------------- 94 | (define (f) 95 | (list (error 'foo "bad stuff") 96 | (let ([x 1]) 97 | (* x 2)))) 98 | -------------------- 99 | 100 | 101 | no-change-test: "lets after expression not known to be pure not extracted" 102 | -------------------- 103 | (define (f) 104 | (list (unknown-code) 105 | (let ([x 1]) 106 | (* x 2)))) 107 | (define (unknown-code) 108 | (void)) 109 | -------------------- 110 | -------------------------------------------------------------------------------- /default-recommendations/syntax-parse-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations syntax-parse-shortcuts 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require (for-syntax racket/base syntax/parse) 11 | syntax/parse/define) 12 | ------------------------------ 13 | 14 | 15 | test: "define-syntax with syntax-parse and one clause refactorable to define-syntax-parse-rule" 16 | ------------------------------ 17 | (define-syntax my-or 18 | (lambda (stx) 19 | (syntax-parse stx 20 | [(_ a b) 21 | #'(let ([tmp a]) (if tmp tmp b))]))) 22 | ============================== 23 | (define-syntax-parse-rule (my-or a b) 24 | (let ([tmp a]) (if tmp tmp b))) 25 | ------------------------------ 26 | 27 | 28 | test: "define-syntax-parser with one clause refactorable to define-syntax-parse-rule" 29 | ------------------------------ 30 | (define-syntax-parser my-or 31 | [(_ a b) 32 | #'(let ([tmp a]) (if tmp tmp b))]) 33 | ============================== 34 | (define-syntax-parse-rule (my-or a b) 35 | (let ([tmp a]) (if tmp tmp b))) 36 | ------------------------------ 37 | 38 | 39 | test: "define-syntax with syntax-parse using stx name refactorable to define-syntax-parse-rule" 40 | ------------------------------ 41 | (define-syntax my-macro 42 | (lambda (stx) 43 | (syntax-parse stx 44 | [(_ x:id) 45 | #'(quote x)]))) 46 | ============================== 47 | (define-syntax-parse-rule (my-macro x:id) 48 | (quote x)) 49 | ------------------------------ 50 | 51 | 52 | test: "define-syntax with syntax-parse using custom name in directives replaced with this-syntax" 53 | ------------------------------ 54 | (define-syntax my-macro 55 | (lambda (input-stx) 56 | (syntax-parse input-stx 57 | [(_ x:id) 58 | #:with loc input-stx 59 | #'(quote (x loc))]))) 60 | ============================== 61 | (define-syntax-parse-rule (my-macro x:id) 62 | #:with loc this-syntax 63 | (quote (x loc))) 64 | ------------------------------ 65 | 66 | 67 | no-change-test: "define-syntax with syntax-parse and multiple clauses not refactorable" 68 | ------------------------------ 69 | (define-syntax my-or 70 | (lambda (stx) 71 | (syntax-parse stx 72 | [(_ a b) 73 | #'(let ([tmp a]) (if tmp tmp b))] 74 | [(_ a) 75 | #'a]))) 76 | ------------------------------ 77 | 78 | 79 | no-change-test: "define-syntax-parser with multiple clauses not refactorable" 80 | ------------------------------ 81 | (define-syntax-parser my-or 82 | [(_ a b) 83 | #'(let ([tmp a]) (if tmp tmp b))] 84 | [(_ a) 85 | #'a]) 86 | ------------------------------ 87 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/argument-let-replacement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [argument-let-replacement refactoring-suite?])) 10 | 11 | 12 | (require racket/list 13 | racket/set 14 | resyntax/base 15 | resyntax/default-recommendations/analyzers/function-expression-analyzer 16 | resyntax/default-recommendations/private/definition-context 17 | resyntax/default-recommendations/private/pure-expression 18 | resyntax/default-recommendations/private/syntax-identifier-sets 19 | syntax/id-set 20 | syntax/parse) 21 | 22 | 23 | ;@---------------------------------------------------------------------------------------------------- 24 | 25 | 26 | ;; This rule extracts let expressions from function arguments into internal definitions. 27 | ;; It only applies when: 28 | ;; 1. We're in a function application (not a macro call) 29 | ;; 2. At least one argument is a let expression 30 | ;; 3. It's safe to extract (no identifier shadowing issues) 31 | 32 | 33 | (define-syntax-class let-or-pure-expression 34 | #:attributes (body-expr [bind-id 1] [bind-rhs 1]) 35 | #:literals (let) 36 | 37 | (pattern (let ([id:id rhs:expr] ...) inner:let-or-pure-expression) 38 | #:attr body-expr (attribute inner.body-expr) 39 | #:attr [bind-id 1] (append (attribute id) (attribute inner.bind-id)) 40 | #:attr [bind-rhs 1] (append (attribute rhs) (attribute inner.bind-rhs))) 41 | 42 | (pattern body-expr:pure-expression 43 | #:attr [bind-id 1] '() 44 | #:attr [bind-rhs 1] '())) 45 | 46 | 47 | (define-definition-context-refactoring-rule extract-lets-from-function-arguments 48 | #:description 49 | "Use internal definitions instead of `let` expressions inside function arguments to reduce nesting." 50 | #:analyzers (list function-expression-analyzer) 51 | 52 | (~seq leading-body ... 53 | (~and original-call 54 | (func:pure-expression arg:let-or-pure-expression ...+ arg-after ...))) 55 | 56 | #:when (equal? (syntax-property (attribute func) 'application-subexpression-kind) 'function) 57 | #:with (all-bind-id ...) (apply append (attribute arg.bind-id)) 58 | #:with (all-bind-rhs ...) (apply append (attribute arg.bind-rhs)) 59 | #:when (not (empty? (attribute all-bind-id))) 60 | 61 | (leading-body ... 62 | (~@ . (~focus-replacement-on 63 | (~splicing-replacement 64 | ((define all-bind-id all-bind-rhs) ... (func arg.body-expr ...)) 65 | #:original original-call))))) 66 | 67 | 68 | (define-refactoring-suite argument-let-replacement 69 | #:rules (extract-lets-from-function-arguments)) 70 | -------------------------------------------------------------------------------- /private/git.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [git-diff-modified-lines (-> string? (hash/c path? immutable-range-set?))] 10 | [git-commit! (-> string? void?)])) 11 | 12 | 13 | (require fancy-app 14 | racket/match 15 | racket/port 16 | racket/string 17 | racket/system 18 | rebellion/base/comparator 19 | rebellion/base/option 20 | rebellion/base/range 21 | rebellion/collection/range-set) 22 | 23 | 24 | ;@---------------------------------------------------------------------------------------------------- 25 | 26 | 27 | 28 | (define (git-diff-modified-lines ref) 29 | (define cmd 30 | (format 31 | "git diff -U0 --inter-hunk-context=0 --diff-filter=AM ~a | grep -e '^+++ b/' -e '^@@'" ref)) 32 | (define empty-lines (range-set #:comparator natural<=>)) 33 | (for*/fold ([files (hash)] 34 | [current-file #false] 35 | #:result files) 36 | ([line (in-list (string-split (with-output-to-string (λ () (system cmd))) "\n"))] 37 | [lexeme (in-option (lex-line line))]) 38 | (if (path? lexeme) 39 | (values files lexeme) 40 | (values (hash-update files current-file (range-set-add _ lexeme) empty-lines) 41 | current-file)))) 42 | 43 | 44 | (define (lex-line line) 45 | (define file-match (regexp-match #px"^\\+\\+\\+ b/(.*)$" line)) 46 | (define single-line-match (regexp-match #px"^@@ .* \\+(\\d+) @@" line)) 47 | (define range-match (regexp-match #px"^@@ .* \\+(\\d+),(\\d+) @@" line)) 48 | (cond 49 | [file-match 50 | (match-define (list _ f) file-match) 51 | (present (simplify-path f))] 52 | [single-line-match 53 | (match-define (list _ l) single-line-match) 54 | (let ([l (string->number l)]) 55 | (present (closed-open-range l (add1 l) #:comparator natural<=>)))] 56 | [range-match 57 | (match-define (list _ l s) range-match) 58 | (let ([l (string->number l)] 59 | [s (string->number s)]) 60 | (if (equal? s 0) 61 | absent ;; TODO: fix range-set-add so that I can return an empty range here 62 | (present (closed-open-range l (+ l s) #:comparator natural<=>))))] 63 | [else 64 | (raise-argument-error 65 | 'lex-line 66 | "a git file name line (starting with '+++ b/') or a hunk range line (starting with '@@')" 67 | line)])) 68 | 69 | 70 | (define (git-commit! message) 71 | (define escaped-message (string-replace message "'" "'\"'\"'")) 72 | (unless (system (format "git commit --all --quiet --message='~a'" escaped-message)) 73 | (raise-arguments-error 'git-commit! 74 | "committing files to Git failed" 75 | "commit message" message))) 76 | -------------------------------------------------------------------------------- /default-recommendations/numeric-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [numeric-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require rebellion/private/static-name 13 | resyntax/base 14 | resyntax/default-recommendations/private/lambda-by-any-name 15 | syntax/parse) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-refactoring-rule add1-lambda-to-add1 22 | #:description "This lambda function is equivalent to the built-in `add1` function." 23 | #:literals (+) 24 | (lambda:lambda-by-any-name (x1:id) (~or (+ x2:id 1) (+ 1 x2:id))) 25 | #:when (free-identifier=? #'x1 #'x2) 26 | add1) 27 | 28 | 29 | (define-refactoring-rule sub1-lambda-to-sub1 30 | #:description "This lambda function is equivalent to the built-in `sub1` function." 31 | #:literals (+ -) 32 | (lambda:lambda-by-any-name (x1:id) (~or (- x2:id 1) (+ x2:id -1) (+ -1 x2:id))) 33 | #:when (free-identifier=? #'x1 #'x2) 34 | sub1) 35 | 36 | 37 | (define-refactoring-rule zero-comparison-lambda-to-positive? 38 | #:description "This lambda function is equivalent to the built-in `positive?` predicate." 39 | #:literals (< > <= >= not) 40 | (lambda:lambda-by-any-name (x1:id) 41 | (~or (> x2:id 0) 42 | (< 0 x2:id) 43 | (not (<= x2:id 0)) 44 | (not (>= 0 x2:id)))) 45 | #:when (free-identifier=? #'x1 #'x2) 46 | positive?) 47 | 48 | 49 | (define-refactoring-rule zero-comparison-lambda-to-negative? 50 | #:description "This lambda function is equivalent to the built-in `negative?` predicate." 51 | #:literals (< > <= >= not) 52 | (lambda:lambda-by-any-name (x1:id) 53 | (~or (< x2:id 0) 54 | (> 0 x2:id) 55 | (not (>= x2:id 0)) 56 | (not (<= 0 x2:id)))) 57 | #:when (free-identifier=? #'x1 #'x2) 58 | negative?) 59 | 60 | 61 | (define-refactoring-rule single-argument-plus-to-identity 62 | #:description "This expression is equivalent to the identity." 63 | #:literals (+) 64 | (+ e) 65 | e) 66 | 67 | 68 | (define-refactoring-rule single-argument-multiply-to-identity 69 | #:description "This expression is equivalent to the identity." 70 | #:literals (*) 71 | (* e) 72 | e) 73 | 74 | 75 | (define-refactoring-suite numeric-shortcuts 76 | #:rules (add1-lambda-to-add1 77 | single-argument-multiply-to-identity 78 | single-argument-plus-to-identity 79 | sub1-lambda-to-sub1 80 | zero-comparison-lambda-to-negative? 81 | zero-comparison-lambda-to-positive?)) 82 | -------------------------------------------------------------------------------- /default-recommendations/dict-suggestions-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations dict-suggestions 5 | 6 | 7 | header: 8 | -------------------- 9 | #lang racket/base 10 | (require racket/dict) 11 | -------------------- 12 | 13 | 14 | test: "in-dict refactorable to in-dict-keys when only the key is used" 15 | -------------------- 16 | (for ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 17 | (displayln k)) 18 | ==================== 19 | (for ([k (in-dict-keys (hash 'a 1 'b 2 'c 3))]) 20 | (displayln k)) 21 | -------------------- 22 | 23 | 24 | test: "in-dict refactorable to in-dict-values when only the value is used" 25 | -------------------- 26 | (for ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 27 | (displayln v)) 28 | ==================== 29 | (for ([v (in-dict-values (hash 'a 1 'b 2 'c 3))]) 30 | (displayln v)) 31 | -------------------- 32 | 33 | 34 | no-change-test: "in-dict not refactorable to in-dict-keys when key and value both used" 35 | -------------------- 36 | (for ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 37 | (displayln k) 38 | (displayln v)) 39 | -------------------- 40 | 41 | 42 | test: "in-dict between other clauses refactorable to in-dict-keys when only the key is used" 43 | -------------------- 44 | (for ([i (in-naturals)] 45 | [(k v) (in-dict (hash 'a 1 'b 2 'c 3))] 46 | [j (in-naturals)]) 47 | (displayln (list i j k))) 48 | ==================== 49 | (for ([i (in-naturals)] 50 | [k (in-dict-keys (hash 'a 1 'b 2 'c 3))] 51 | [j (in-naturals)]) 52 | (displayln (list i j k))) 53 | -------------------- 54 | 55 | 56 | test: "in-dict between other clauses refactorable to in-dict-values when only the value is used" 57 | -------------------- 58 | (for ([i (in-naturals)] 59 | [(k v) (in-dict (hash 'a 1 'b 2 'c 3))] 60 | [j (in-naturals)]) 61 | (displayln (list i j v))) 62 | ==================== 63 | (for ([i (in-naturals)] 64 | [v (in-dict-values (hash 'a 1 'b 2 'c 3))] 65 | [j (in-naturals)]) 66 | (displayln (list i j v))) 67 | -------------------- 68 | 69 | 70 | test: "in-dict in for* loop refactorable to in-dict-keys" 71 | -------------------- 72 | (for* ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 73 | (displayln k)) 74 | ==================== 75 | (for* ([k (in-dict-keys (hash 'a 1 'b 2 'c 3))]) 76 | (displayln k)) 77 | -------------------- 78 | 79 | 80 | test: "in-dict in for/list loop refactorable to in-dict-keys" 81 | -------------------- 82 | (for/list ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 83 | k) 84 | ==================== 85 | (for/list ([k (in-dict-keys (hash 'a 1 'b 2 'c 3))]) 86 | k) 87 | -------------------- 88 | 89 | 90 | test: "in-dict in for/list loop refactorable to in-dict-values" 91 | -------------------- 92 | (for/list ([(k v) (in-dict (hash 'a 1 'b 2 'c 3))]) 93 | v) 94 | ==================== 95 | (for/list ([v (in-dict-values (hash 'a 1 'b 2 'c 3))]) 96 | v) 97 | -------------------- 98 | -------------------------------------------------------------------------------- /default-recommendations/exception-suggestions.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [exception-suggestions refactoring-suite?] 10 | [disabled-exception-suggestions refactoring-suite?])) 11 | 12 | 13 | (require racket/string 14 | resyntax/base 15 | resyntax/default-recommendations/private/literal-constant 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-refactoring-rule literal-exception-handler-to-lambda 23 | #:description 24 | "A `with-handlers` handler should be a procedure. Wrap this literal in a lambda." 25 | #:literals (with-handlers) 26 | 27 | (with-handlers (clause-before ... 28 | [pred:expr handler:literal-constant] 29 | clause-after ...) 30 | body:expr ...) 31 | 32 | (with-handlers (clause-before ... 33 | [pred (λ (_) handler)] 34 | clause-after ...) 35 | body ...)) 36 | 37 | 38 | (define-refactoring-rule error-to-raise-arguments-error 39 | #:description 40 | "Use `raise-arguments-error` instead of `error` for better error messages that follow Racket \ 41 | conventions." 42 | #:literals (error) 43 | 44 | (error sym:expr message:str arg:id ...+) 45 | 46 | #:do [(define message-str (syntax-e (attribute message))) 47 | (define args-list (attribute arg)) 48 | (define tilde-a-matches (regexp-match-positions* #rx"~a" message-str))] 49 | #:when (= (length tilde-a-matches) (length args-list)) 50 | ;; Check that all ~a occurrences are surrounded by spaces or at string boundaries 51 | #:when (for/and ([match (in-list tilde-a-matches)]) 52 | (define start (car match)) 53 | (define end (cdr match)) 54 | (define before-ok? (or (= start 0) 55 | (char-whitespace? (string-ref message-str (- start 1))))) 56 | (define after-ok? (or (= end (string-length message-str)) 57 | (char-whitespace? (string-ref message-str end)))) 58 | (and before-ok? after-ok?)) 59 | #:do [(define cleaned-message (string-replace message-str "~a" "")) 60 | ;; Clean up extra spaces and trailing punctuation from placeholder removal 61 | (define cleaned-message-normalized 62 | (regexp-replace* #rx" +" cleaned-message " "))] 63 | #:with new-message (regexp-replace #rx"[,;: ]+$" cleaned-message-normalized "") 64 | #:with (arg-str ...) 65 | (for/list ([arg-id (in-list args-list)]) 66 | (symbol->string (syntax-e arg-id))) 67 | 68 | (raise-arguments-error sym new-message (~@ arg-str arg) ...)) 69 | 70 | 71 | (define-refactoring-suite exception-suggestions 72 | #:rules (literal-exception-handler-to-lambda)) 73 | 74 | 75 | (define-refactoring-suite disabled-exception-suggestions 76 | #:rules (error-to-raise-arguments-error)) 77 | -------------------------------------------------------------------------------- /private/limiting.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [limiting (-> (>=/c 0) #:by (-> any/c (>=/c 0)) transducer?)])) 10 | 11 | 12 | (require rebellion/base/variant 13 | rebellion/streaming/transducer) 14 | 15 | 16 | (module+ test 17 | (require racket/match 18 | rackunit 19 | rebellion/collection/list 20 | (submod ".."))) 21 | 22 | 23 | ;@---------------------------------------------------------------------------------------------------- 24 | 25 | 26 | (struct limiting-emit-state (weight-so-far element) #:transparent) 27 | 28 | 29 | (define (limiting max-weight #:by weight-function) 30 | 31 | (define (start) 32 | (variant #:consume 0)) 33 | 34 | (define (consume weight-so-far v) 35 | (define new-weight (+ weight-so-far (weight-function v))) 36 | (cond 37 | [(< new-weight max-weight) (variant #:emit (limiting-emit-state new-weight v))] 38 | [(> new-weight max-weight) (variant #:consume weight-so-far)] 39 | [else (variant #:half-closed-emit v)])) 40 | 41 | (define (emit s) 42 | (define weight-so-far (limiting-emit-state-weight-so-far s)) 43 | 44 | (emission (variant #:consume weight-so-far) (limiting-emit-state-element s))) 45 | 46 | (define (half-closed-emit v) 47 | (half-closed-emission (variant #:finish #false) v)) 48 | 49 | (make-transducer #:starter start 50 | #:consumer consume 51 | #:emitter emit 52 | #:half-closer (λ (_) (variant #:finish #false)) 53 | #:half-closed-emitter half-closed-emit 54 | #:finisher void 55 | #:name 'limiting)) 56 | 57 | 58 | (module+ test 59 | (test-case "limiting" 60 | (define inputs (list 'small 'big 'medium 'medium 'big 'small)) 61 | 62 | (define (weight i) 63 | (match i 64 | ['small 1] 65 | ['medium 5] 66 | ['big 10])) 67 | 68 | (check-equal? (transduce inputs (limiting 3 #:by weight) #:into into-list) (list 'small 'small)) 69 | (check-equal? (transduce inputs (limiting 13 #:by weight) #:into into-list) 70 | (list 'small 'big 'small)) 71 | (check-equal? (transduce inputs (limiting 16 #:by weight) #:into into-list) 72 | (list 'small 'big 'medium)) 73 | (check-equal? (transduce inputs (limiting +inf.0 #:by weight) #:into into-list) 74 | (list 'small 'big 'medium 'medium 'big 'small)) 75 | (check-equal? (transduce (list 'small 'big 'small 'big 'small 'big 'small 'big 'small 'big) 76 | (limiting 3 #:by weight) 77 | #:into into-list) 78 | (list 'small 'small 'small)) 79 | (check-equal? (transduce (list 'small 'big 'small 'big 'small 'big 'small 'big 'small 'big) 80 | (limiting 5 #:by weight) 81 | #:into into-list) 82 | (list 'small 'small 'small 'small 'small)))) 83 | -------------------------------------------------------------------------------- /default-recommendations/contract-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations contract-shortcuts 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require racket/contract/base) 11 | ------------------------------ 12 | 13 | 14 | test: "nested or/c contracts can be flattened" 15 | - (void (or/c 1 2 (or/c 3 4))) 16 | - (void (or/c 1 2 3 4)) 17 | 18 | 19 | no-change-test: "flat or/c contracts can't be flattened" 20 | - (or/c 1 2 3) 21 | 22 | 23 | test: "multiple nested or/c contracts can be flattened at once" 24 | - (void (or/c (or/c 1 2) (or/c 3 4) (or/c 5 6))) 25 | - (void (or/c 1 2 3 4 5 6)) 26 | 27 | 28 | test: "deeply nested or/c contracts can be flattened in one pass" 29 | - (void (or/c 1 (or/c 2 (or/c 3 (or/c 4 5 6))))) 30 | - (void (or/c 1 2 3 4 5 6)) 31 | 32 | 33 | no-change-test: "multiline nested or/c contracts can't be flattened" 34 | ------------------------------ 35 | (or/c 1 36 | (or/c 2 3)) 37 | ------------------------------ 38 | 39 | 40 | test: "nested and/c contracts can be flattened" 41 | - (void (and/c 1 2 (and/c 3 4))) 42 | - (void (and/c 1 2 3 4)) 43 | 44 | 45 | no-change-test: "flat and/c contracts can't be flattened" 46 | - (and/c 1 2 3) 47 | 48 | 49 | test: "multiple nested and/c contracts can be flattened at once" 50 | - (void (and/c (and/c 1 2) (and/c 3 4) (and/c 5 6))) 51 | - (void (and/c 1 2 3 4 5 6)) 52 | 53 | 54 | test: "deeply nested and/c contracts can be flattened in one pass" 55 | - (void (and/c 1 (and/c 2 (and/c 3 (and/c 4 5 6))))) 56 | - (void (and/c 1 2 3 4 5 6)) 57 | 58 | 59 | no-change-test: "multiline nested and/c contracts can't be flattened" 60 | ------------------------------ 61 | (and/c 1 62 | (and/c 2 3)) 63 | ------------------------------ 64 | 65 | 66 | test: "nested or/c contracts interspersed with and/c contracts can be flattened" 67 | - (void (or/c (or/c 1 2) (and/c 3 4) (or/c 5 6))) 68 | - (void (or/c 1 2 (and/c 3 4) 5 6)) 69 | 70 | 71 | test: "nested and/c contracts interspersed with or/c contracts can be flattened" 72 | - (void (and/c (and/c 1 2) (or/c 3 4) (and/c 5 6))) 73 | - (void (and/c 1 2 (or/c 3 4) 5 6)) 74 | 75 | 76 | test: "contracts equivalent to path-string? can be refactored to path-string?" 77 | - (void (or/c path? string?)) 78 | - (void (or/c string? path?)) 79 | - (void path-string?) 80 | 81 | 82 | test: "->* contracts using #:rest (listof arg) can be replaced with -> and ellipses" 83 | - (void (->* (string? number?) #:rest (listof symbol?) list?)) 84 | - (void (->* (string? number?) () #:rest (listof symbol?) list?)) 85 | - (void (-> string? number? symbol? ... list?)) 86 | 87 | 88 | test: "infix ->* contracts using #:rest (listof arg) can be replaced with -> and ellipses" 89 | - (void ((string? number?) #:rest (listof symbol?) . ->* . list?)) 90 | - (void (-> string? number? symbol? ... list?)) 91 | 92 | 93 | no-change-test: 94 | "->* contracts using #:rest and optional arguments not refactorable to -> and ellipses" 95 | - (void (->* () (string?) #:rest (listof symbol?) list?)) 96 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/variable-mutability.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [variable-mutability-analyzer expansion-analyzer?])) 10 | 11 | 12 | (require racket/list 13 | racket/match 14 | racket/stream 15 | rebellion/collection/entry 16 | rebellion/streaming/transducer 17 | resyntax/default-recommendations/analyzers/private/expanded-id-table 18 | resyntax/private/analyzer 19 | resyntax/private/syntax-path 20 | resyntax/private/syntax-property-bundle 21 | resyntax/private/syntax-traversal 22 | syntax/id-table 23 | syntax/parse) 24 | 25 | 26 | (module+ test 27 | (require (submod "..") 28 | rackunit)) 29 | 30 | 31 | ;@---------------------------------------------------------------------------------------------------- 32 | 33 | 34 | (define (mutated-variables expanded-stx) 35 | (let loop ([expanded-stx expanded-stx] [phase 0]) 36 | (syntax-search expanded-stx 37 | #:literal-sets ([kernel-literals #:phase phase]) 38 | [(id:id _ ...) 39 | #:do [(define id-phase (syntax-property (attribute id) 'phase))] 40 | #:when (not (equal? id-phase phase)) 41 | (loop this-syntax id-phase)] 42 | [(quote-syntax _ ...) (stream)] 43 | [(set! id:id expr) 44 | (stream-cons (attribute id) (mutated-variables (attribute expr)))]))) 45 | 46 | 47 | (define (variable-mutability stx) 48 | (define labeled-stx (syntax-label-id-phases (syntax-label-paths stx 'expanded-path))) 49 | 50 | ;; Create table and initialize all bound identifiers with 'immutable 51 | (define variable-table (make-expanded-id-table)) 52 | (for ([id (in-stream (binding-site-identifiers labeled-stx))]) 53 | (define phase (syntax-property id 'phase)) 54 | (expanded-id-table-set! variable-table (expanded-identifier id phase) 'immutable)) 55 | 56 | ;; Mark mutated variables as 'mutable 57 | (for ([id (in-stream (mutated-variables labeled-stx))]) 58 | (define phase (syntax-property id 'phase)) 59 | (expanded-id-table-set! variable-table (expanded-identifier id phase) 'mutable)) 60 | 61 | (transduce (in-expanded-id-table variable-table) 62 | (mapping 63 | (λ (e) 64 | (define expanded-id (entry-key e)) 65 | (define mode (entry-value e)) 66 | (define id (expanded-identifier-syntax expanded-id)) 67 | (define path (syntax-property id 'expanded-path)) 68 | (syntax-property-entry path 'variable-mutability mode))) 69 | #:into into-syntax-property-bundle)) 70 | 71 | 72 | (define variable-mutability-analyzer 73 | (make-expansion-analyzer variable-mutability #:name 'variable-mutability-analyzer)) 74 | 75 | 76 | (module+ test 77 | (test-case "variable-mutability-analyzer" 78 | 79 | (test-case "empty module" 80 | (define stx #'(module foo racket/base)) 81 | (define props (expansion-analyze variable-mutability-analyzer (expand stx))) 82 | (check-equal? props (syntax-property-bundle))))) 83 | -------------------------------------------------------------------------------- /default-recommendations/legacy/define-simple-macro-migration-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations define-simple-macro-migration 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require syntax/parse/define) 11 | ------------------------------ 12 | 13 | 14 | test: "define-simple-macro refactorable to define-syntax-parse-rule" 15 | ------------------------------ 16 | (define-simple-macro (my-or a:expr b:expr) 17 | (let ([tmp a]) (if a a b))) 18 | ============================== 19 | (define-syntax-parse-rule (my-or a:expr b:expr) 20 | (let ([tmp a]) (if a a b))) 21 | ------------------------------ 22 | 23 | 24 | test: "define-simple-macro with body comments refactorable to define-syntax-parse-rule" 25 | ------------------------------ 26 | (define-simple-macro (my-or a:expr b:expr) 27 | ;; The let form is needed to avoid evaluating a twice. 28 | (let ([tmp a]) (if a a b))) 29 | ============================== 30 | (define-syntax-parse-rule (my-or a:expr b:expr) 31 | ;; The let form is needed to avoid evaluating a twice. 32 | (let ([tmp a]) (if a a b))) 33 | ------------------------------ 34 | 35 | 36 | no-change-test: 37 | "define-syntax-parse-rule not refactorable (https://github.com/jackfirth/resyntax/issues/106)" 38 | ------------------------------ 39 | (define-syntax-parse-rule (my-or a:expr b:expr) 40 | ;; The let form is needed to avoid evaluating a twice. 41 | (let ([tmp a]) (if a a b))) 42 | ------------------------------ 43 | 44 | 45 | test: "migrating define-simple-macro doesn't reformat the entire macro definition" 46 | ------------------------------ 47 | (define-simple-macro (my-or a:expr b:expr) 48 | ( let ([tmp a] ) 49 | (if a a b))) 50 | ============================== 51 | (define-syntax-parse-rule (my-or a:expr b:expr) 52 | ( let ([tmp a] ) 53 | (if a a b))) 54 | ------------------------------ 55 | 56 | 57 | test: "migrating define-simple-macro does reformat when the header is long" 58 | ------------------------------ 59 | (define-simple-macro (my-or a:expr b:expr fooooooooooooooooooooooooooooooooooooooooooooooooooooooo) 60 | ( let ([tmp a] ) 61 | (if a a b))) 62 | ============================== 63 | (define-syntax-parse-rule (my-or a:expr 64 | b:expr 65 | fooooooooooooooooooooooooooooooooooooooooooooooooooooooo) 66 | (let ([tmp a]) (if a a b))) 67 | ------------------------------ 68 | 69 | 70 | test: "migrating define-simple-macro does reformat when the header is multiple lines" 71 | ------------------------------ 72 | (define-simple-macro (my-or 73 | a:expr b:expr) 74 | ( let ([tmp a] ) 75 | (if a a b))) 76 | ============================== 77 | (define-syntax-parse-rule (my-or a:expr b:expr) 78 | (let ([tmp a]) (if a a b))) 79 | ------------------------------ 80 | 81 | 82 | test: "migrating define-simple-macro does reformat when the header is on the next line" 83 | ------------------------------ 84 | (define-simple-macro 85 | (my-or 86 | a:expr b:expr) 87 | ( let ([tmp a] ) 88 | (if a a b))) 89 | ============================== 90 | (define-syntax-parse-rule (my-or a:expr b:expr) 91 | (let ([tmp a]) (if a a b))) 92 | ------------------------------ 93 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/ignored-result-values.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [ignored-result-values-analyzer expansion-analyzer?])) 10 | 11 | 12 | (require racket/stream 13 | resyntax/private/analyzer 14 | resyntax/private/syntax-path 15 | resyntax/private/syntax-property-bundle 16 | resyntax/private/syntax-traversal 17 | syntax/parse) 18 | 19 | 20 | (module+ test 21 | (require (submod "..") 22 | rackunit)) 23 | 24 | 25 | ;@---------------------------------------------------------------------------------------------------- 26 | 27 | 28 | (define (ignored-result-values stx) 29 | (let loop ([stx (syntax-label-paths stx 'expansion-path)]) 30 | 31 | (define (mark-result stx mode) 32 | (define path (syntax-property stx 'expansion-path)) 33 | (stream-cons (syntax-property-entry path 'expression-result mode) (loop stx))) 34 | 35 | (define (mark-all stxs mode) 36 | (stream-append-all 37 | (for/list ([stx (in-list stxs)]) 38 | (mark-result stx mode)))) 39 | 40 | (syntax-search stx 41 | #:literal-sets (kernel-literals) 42 | 43 | [((~or define-values define-syntaxes) _ expr) 44 | (mark-result (attribute expr) 'used)] 45 | 46 | [(#%plain-lambda _ body ... result) 47 | (stream-append 48 | (mark-all (attribute body) 'ignored) 49 | (mark-result (attribute result) 'used))] 50 | 51 | [(case-lambda [_ body ... result] ...) 52 | (stream-append-all 53 | (for/list ([bodies (in-list (attribute body))] 54 | [result-stx (in-list (attribute result))]) 55 | (stream-append (mark-all bodies 'ignored) 56 | (mark-result result-stx 'used))))] 57 | 58 | [(if condition true-branch false-branch) 59 | (stream-append 60 | (mark-result (attribute condition) 'used) 61 | (mark-result (attribute true-branch) 'used) 62 | (mark-result (attribute false-branch) 'used))] 63 | 64 | [(begin body ... result) 65 | (stream-append 66 | (mark-all (attribute body) 'ignored) 67 | (mark-result (attribute result) 'used))] 68 | 69 | [(begin0 result body ...) 70 | (stream-append (mark-result (attribute result) 'used) 71 | (mark-all (attribute body) 'ignored))] 72 | 73 | [((~or let-values letrec-values) ([_ expr] ...) 74 | body ... 75 | result) 76 | (stream-append (mark-all (attribute expr) 'used) 77 | (mark-all (attribute body) 'ignored) 78 | (mark-result (attribute result) 'used))] 79 | 80 | [(set! _ expr) (mark-result (attribute expr) 'used)] 81 | 82 | [(with-continuation-mark key val result) 83 | (stream-append 84 | (mark-result (attribute key) 'used) 85 | (mark-result (attribute val) 'used) 86 | (mark-result (attribute result) 'used))] 87 | 88 | [(#%plain-app func-or-arg ...) (mark-all (attribute func-or-arg) 'used)]))) 89 | 90 | 91 | (define ignored-result-values-analyzer 92 | (make-expansion-analyzer 93 | (λ (stx) (sequence->syntax-property-bundle (ignored-result-values stx))) 94 | #:name 'ignored-result-values-analyzer)) 95 | 96 | 97 | (define (stream-append-all streams) 98 | (apply stream-append streams)) 99 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-contract-migrations-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations legacy-contract-migrations 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require racket/contract) 11 | ------------------------------ 12 | 13 | 14 | test: "predicate/c in expression position refactorable to ->" 15 | - (void predicate/c) 16 | - (void (-> any/c boolean?)) 17 | 18 | 19 | test: "predicate/c in contract-out refactorable to ->" 20 | ------------------------------ 21 | (provide (contract-out [foo? predicate/c])) 22 | (define (foo? _) 23 | #true) 24 | ============================== 25 | (provide (contract-out [foo? (-> any/c boolean?)])) 26 | (define (foo? _) 27 | #true) 28 | ------------------------------ 29 | 30 | 31 | test: "predicate/c in define/contract refactorable to ->" 32 | ------------------------------ 33 | (require racket/contract/region) 34 | (define/contract (foo? _) 35 | predicate/c 36 | #true) 37 | ============================== 38 | (require racket/contract/region) 39 | (define/contract (foo? _) 40 | (-> any/c boolean?) 41 | #true) 42 | ------------------------------ 43 | 44 | 45 | test: "false/c refactorable to #f" 46 | - (void false/c) 47 | - (void #f) 48 | 49 | 50 | test: "false/c in contract-out refactorable to #f" 51 | ------------------------------ 52 | (provide (contract-out [some-val false/c])) 53 | (define some-val #f) 54 | ============================== 55 | (provide (contract-out [some-val #f])) 56 | (define some-val #f) 57 | ------------------------------ 58 | 59 | 60 | test: "symbols refactorable to or/c" 61 | - (void (symbols 'a 'b 'c)) 62 | - (void (or/c 'a 'b 'c)) 63 | 64 | 65 | test: "symbols with single symbol refactorable to or/c" 66 | - (void (symbols 'foo)) 67 | - (void (or/c 'foo)) 68 | 69 | 70 | test: "vector-immutableof refactorable to vectorof with #:immutable" 71 | - (void (vector-immutableof string?)) 72 | - (void (vectorof string? #:immutable #t)) 73 | 74 | 75 | test: "vector-immutable/c refactorable to vector/c with #:immutable" 76 | - (void (vector-immutable/c string? number?)) 77 | - (void (vector/c string? number? #:immutable #t)) 78 | 79 | 80 | test: "vector-immutable/c with single contract refactorable to vector/c with #:immutable" 81 | - (void (vector-immutable/c string?)) 82 | - (void (vector/c string? #:immutable #t)) 83 | 84 | 85 | test: "box-immutable/c refactorable to box/c with #:immutable" 86 | - (void (box-immutable/c string?)) 87 | - (void (box/c string? #:immutable #t)) 88 | 89 | 90 | test: "flat-contract refactorable to predicate" 91 | - (void (flat-contract string?)) 92 | - (void string?) 93 | 94 | 95 | test: "flat-contract in contract-out refactorable to predicate" 96 | ------------------------------ 97 | (provide (contract-out [some-val (flat-contract string?)])) 98 | (define some-val "hello") 99 | ============================== 100 | (provide (contract-out [some-val string?])) 101 | (define some-val "hello") 102 | ------------------------------ 103 | 104 | 105 | test: "contract-struct refactorable to struct" 106 | - (contract-struct person (name age)) 107 | - (struct person (name age)) 108 | 109 | 110 | test: "define-contract-struct refactorable to struct with extra constructor" 111 | - (define-contract-struct point (x y)) 112 | - (struct point (x y) #:extra-constructor-name make-point) 113 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/let-replacement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [let-replacement refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | racket/list 14 | racket/set 15 | rebellion/private/static-name 16 | resyntax/base 17 | resyntax/default-recommendations/analyzers/identifier-usage 18 | resyntax/default-recommendations/private/definition-context 19 | resyntax/default-recommendations/private/syntax-identifier-sets 20 | resyntax/default-recommendations/let-replacement/private/let-binding 21 | resyntax/private/syntax-replacement 22 | syntax/id-set 23 | syntax/parse) 24 | 25 | 26 | ;@---------------------------------------------------------------------------------------------------- 27 | 28 | 29 | (define-definition-context-refactoring-rule let-to-define 30 | #:description 31 | "Internal definitions are recommended instead of `let` expressions, to reduce nesting." 32 | #:analyzers (list identifier-usage-analyzer) 33 | (~seq leading-body ... let-expression:refactorable-let-expression) 34 | #:with (replacement ...) 35 | (if (empty? (attribute leading-body)) 36 | (attribute let-expression.refactored) 37 | #'(~focus-replacement-on (let-expression.refactored ...))) 38 | (leading-body ... replacement ...)) 39 | 40 | 41 | (define-definition-context-refactoring-rule define-let-to-multi-define 42 | #:description "This `let` expression can be pulled up into multiple `define` expressions." 43 | #:literals (define let) 44 | (~seq body-before ... 45 | (~and original-definition 46 | (define id:id (let ([nested-id:id nested-expr:expr] ...) expr:expr))) 47 | body-after ...) 48 | #:when (for/and ([nested-expr (in-list (attribute nested-expr))]) 49 | (identifier-binding-unchanged-in-context? (attribute id) nested-expr)) 50 | #:when (for*/and ([body-free-id 51 | (in-free-id-set 52 | (syntax-free-identifiers #'(body-before ... (nested-expr ...) body-after ...)))] 53 | [nested-id (in-list (attribute nested-id))]) 54 | (identifier-binding-unchanged-in-context? body-free-id nested-id)) 55 | (body-before ... 56 | (~@ . (~focus-replacement-on 57 | (~splicing-replacement ((define nested-id nested-expr) ... (define id expr)) 58 | #:original original-definition))) 59 | body-after ...)) 60 | 61 | 62 | (define-definition-context-refactoring-rule begin0-let-to-define-begin0 63 | #:description 64 | "The `let` expression in this `begin0` form can be extracted into the surrounding definition\ 65 | context." 66 | #:literals (begin0 let) 67 | (~seq body-before ... 68 | (begin0 69 | (~and original-let (let ([nested-id:id nested-expr:expr]) let-body ... result-expr:expr)) 70 | body-after ...)) 71 | #:when (not 72 | (set-member? (syntax-bound-identifiers #'(body-before ... body-after ...)) #'nested-id)) 73 | (body-before ... 74 | (define nested-id nested-expr) 75 | let-body ... 76 | (begin0 (~replacement result-expr #:original original-let) body-after ...))) 77 | 78 | 79 | (define-refactoring-suite let-replacement 80 | #:rules (let-to-define 81 | define-let-to-multi-define 82 | begin0-let-to-define-begin0)) 83 | -------------------------------------------------------------------------------- /default-recommendations/syntax-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [syntax-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require racket/string 13 | racket/syntax 14 | rebellion/private/static-name 15 | resyntax/base 16 | syntax/parse) 17 | 18 | 19 | ;@---------------------------------------------------------------------------------------------------- 20 | 21 | 22 | (define-syntax-class format-id-argument 23 | #:attributes (uses-syntax-e? simplified) 24 | #:literals (syntax-e) 25 | 26 | (pattern (syntax-e simplified:expr) 27 | #:with uses-syntax-e? #'#true) 28 | 29 | (pattern simplified:expr 30 | #:with uses-syntax-e? #'#false)) 31 | 32 | 33 | (define-refactoring-rule syntax-e-in-format-id-unnecessary 34 | #:description 35 | "Using `syntax-e` on the arguments of `format-id` is unnecessary, `format-id` already unwrap 36 | syntax object arguments." 37 | #:literals (format-id syntax-e) 38 | 39 | (format-id lctx:expr fmt:expr arg:format-id-argument ...+) 40 | #:when 41 | (for/or ([uses-syntax-e? (attribute arg.uses-syntax-e?)]) 42 | (syntax-e uses-syntax-e?)) 43 | 44 | (format-id lctx fmt arg.simplified ...)) 45 | 46 | 47 | (define-syntax-class format-symbol-argument 48 | #:attributes (simplified) 49 | #:literals (syntax-e keyword->string symbol->string) 50 | 51 | (pattern (syntax-e inner:format-symbol-argument) #:attr simplified (attribute inner.simplified)) 52 | 53 | (pattern (keyword->string inner:format-symbol-argument) 54 | #:attr simplified (attribute inner.simplified)) 55 | 56 | (pattern (symbol->string inner:format-symbol-argument) 57 | #:attr simplified (attribute inner.simplified)) 58 | 59 | (pattern simplified:expr)) 60 | 61 | 62 | ;; The format-symbol function only allows ~a placeholders. Rather a fancy generic utilty that finds 63 | ;; all placeholders, we just explicitly list out all the other ones and check one-by-one whether any 64 | ;; of them are contained in the template string. That's easier to implement and the performance 65 | ;; doesn't matter at all since template strings are almost always short. 66 | (define disallowed-format-symbol-placeholders 67 | (list "~n" 68 | "~%" 69 | "~s" 70 | "~S" 71 | "~v" 72 | "~V" 73 | "~.a" 74 | "~.A" 75 | "~.s" 76 | "~.S" 77 | "~.v" 78 | "~.V" 79 | "~e" 80 | "~E" 81 | "~c" 82 | "~C" 83 | "~b" 84 | "~B" 85 | "~o" 86 | "~O" 87 | "~x" 88 | "~X" 89 | "~ " 90 | "~\n" 91 | "~\t")) 92 | 93 | 94 | (define-refactoring-rule format-string-to-format-symbol 95 | #:description 96 | "This `format` expression can be simplified to an equivalent `format-symbol` expression." 97 | #:literals (format string->symbol) 98 | 99 | (string->symbol (format template:str arg:format-symbol-argument ...)) 100 | #:when (for/and ([disallowed (in-list disallowed-format-symbol-placeholders)]) 101 | (not (string-contains? (syntax-e #'template) disallowed))) 102 | 103 | (format-symbol template (~replacement arg.simplified #:original arg) ...)) 104 | 105 | 106 | (define-refactoring-suite syntax-shortcuts 107 | #:rules (format-string-to-format-symbol 108 | syntax-e-in-format-id-unnecessary)) 109 | -------------------------------------------------------------------------------- /default-recommendations/boolean-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [boolean-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | rebellion/private/static-name 14 | resyntax/base 15 | resyntax/default-recommendations/private/boolean 16 | resyntax/default-recommendations/private/syntax-lines 17 | resyntax/default-recommendations/private/syntax-tree 18 | syntax/parse) 19 | 20 | 21 | ;@---------------------------------------------------------------------------------------------------- 22 | 23 | 24 | (define-refactoring-rule nested-or-to-flat-or 25 | #:description "Nested `or` expressions can be flattened into a single, equivalent `or` expression." 26 | (~var or-tree (syntax-tree #'or)) 27 | ;; Restricted to single-line expressions for now because the syntax-tree operations don't preserve 28 | ;; any formatting between adjacent leaves. 29 | #:when (oneline-syntax? #'or-tree) 30 | #:when (>= (attribute or-tree.rank) 2) 31 | (or or-tree.leaf ...)) 32 | 33 | 34 | (define-refactoring-rule nested-and-to-flat-and 35 | #:description 36 | "Nested `and` expressions can be flattened into a single, equivalent `and` expression." 37 | (~var and-tree (syntax-tree #'and)) 38 | ;; Restricted to single-line expressions for now because the syntax-tree operations don't preserve 39 | ;; any formatting between adjacent leaves. 40 | #:when (oneline-syntax? #'and-tree) 41 | #:when (>= (attribute and-tree.rank) 2) 42 | (and and-tree.leaf ...)) 43 | 44 | 45 | (define-refactoring-rule if-then-true-else-false-to-condition 46 | #:description "The condition of this `if` expression is already a boolean and can be used directly." 47 | #:literals (if) 48 | (if condition:likely-boolean #true #false) 49 | condition) 50 | 51 | 52 | (define-refactoring-rule if-then-false-else-true-to-not 53 | #:description "This `if` expression can be refactored to an equivalent expression using `not`." 54 | #:literals (if) 55 | (if condition #false #true) 56 | (not condition)) 57 | 58 | 59 | (define-refactoring-rule if-else-false-to-and 60 | #:description "This `if` expression can be refactored to an equivalent expression using `and`." 61 | #:literals (if) 62 | (if condition then #false) 63 | (and condition then)) 64 | 65 | 66 | (define-syntax-class negated-condition 67 | #:attributes (flipped) 68 | #:literals (not) 69 | (pattern (not base-condition:expr) 70 | #:with flipped #`(~replacement base-condition #:original #,this-syntax))) 71 | 72 | 73 | (define-refactoring-rule inverted-when 74 | #:description "This negated `when` expression can be replaced by an `unless` expression." 75 | #:literals (when) 76 | (when-id:when negated:negated-condition body ...) 77 | ((~replacement unless #:original when-id) negated.flipped body ...)) 78 | 79 | 80 | (define-refactoring-rule inverted-unless 81 | #:description "This negated `unless` expression can be replaced by a `when` expression." 82 | #:literals (unless) 83 | (unless-id:unless negated:negated-condition body ...) 84 | ((~replacement when #:original unless-id) negated.flipped body ...)) 85 | 86 | 87 | (define-refactoring-suite boolean-shortcuts 88 | #:rules (if-then-false-else-true-to-not 89 | if-then-true-else-false-to-condition 90 | if-else-false-to-and 91 | inverted-when 92 | inverted-unless 93 | nested-and-to-flat-and 94 | nested-or-to-flat-or)) 95 | -------------------------------------------------------------------------------- /default-recommendations/gap-preservation.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | ;; These aren't real refactoring rules. They're only used for testing Resyntax. Specifically, they're 5 | ;; used to test that Resyntax properly preserves comments in between sequences of forms that are left 6 | ;; unchanged by a refactoring rule, even when forms before and after that sequence are changed. See 7 | ;; the accompanying tests in gap-preservation-test.rkt for examples. 8 | 9 | 10 | (require racket/contract/base) 11 | 12 | 13 | (provide 14 | (contract-out 15 | [gap-preservation-rules refactoring-suite?])) 16 | 17 | 18 | (require rebellion/private/static-name 19 | resyntax/base 20 | resyntax/private/syntax-neighbors) 21 | 22 | 23 | ;@---------------------------------------------------------------------------------------------------- 24 | 25 | 26 | (define-refactoring-rule suggest-inserting-foo-first 27 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 28 | #:datum-literals (insert-foo-first) 29 | (insert-foo-first a ...) 30 | ("foo" a ...)) 31 | 32 | 33 | (define-refactoring-rule suggest-inserting-foo-second 34 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 35 | #:datum-literals (insert-foo-second) 36 | (insert-foo-second a0 a ...) 37 | (a0 "foo" a ...)) 38 | 39 | 40 | (define-refactoring-rule suggest-inserting-foo-last 41 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 42 | #:datum-literals (insert-foo-last) 43 | (insert-foo-last a ...) 44 | (a ... "foo")) 45 | 46 | 47 | (define-refactoring-rule suggest-inserting-foo-first-and-last 48 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 49 | #:datum-literals (insert-foo-first-and-last) 50 | (insert-foo-first-and-last a ...) 51 | ("foo" a ... "foo")) 52 | 53 | 54 | (define-refactoring-rule suggest-replacing-first-with-foo 55 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 56 | #:datum-literals (replace-first-with-foo) 57 | (replace-first-with-foo old a ...) 58 | ((~replacement "foo" #:original old) a ...)) 59 | 60 | 61 | (define-refactoring-rule suggest-replacing-second-with-foo 62 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 63 | #:datum-literals (replace-second-with-foo) 64 | (replace-second-with-foo a0 old a ...) 65 | (a0 (~replacement "foo" #:original old) a ...)) 66 | 67 | 68 | (define-refactoring-rule suggest-replacing-last-with-foo 69 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 70 | #:datum-literals (replace-last-with-foo) 71 | (replace-last-with-foo a ... old) 72 | (a ... (~replacement "foo" #:original old))) 73 | 74 | 75 | (define-refactoring-rule suggest-replacing-first-and-last-with-foo 76 | #:description "This refactoring rule is for testing Resyntax, ignore its suggestions." 77 | #:datum-literals (replace-first-and-last-with-foo) 78 | (replace-first-and-last-with-foo old1 a ... old2) 79 | ((~replacement "foo" #:original old1) a ... (~replacement "foo" #:original old2))) 80 | 81 | 82 | (define-refactoring-suite gap-preservation-rules 83 | #:rules (suggest-inserting-foo-first 84 | suggest-inserting-foo-second 85 | suggest-inserting-foo-last 86 | suggest-inserting-foo-first-and-last 87 | suggest-replacing-first-with-foo 88 | suggest-replacing-second-with-foo 89 | suggest-replacing-last-with-foo 90 | suggest-replacing-first-and-last-with-foo)) 91 | -------------------------------------------------------------------------------- /default-recommendations/private/syntax-tree.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | ;; This module defines a syntax-tree syntax class for recognizing trees of nested expressions. It's 5 | ;; primarily intended for implementing various tree-flattening refactoring rules that rewrite forms 6 | ;; like (or a b (or c d) e) to (or a b c d e). The syntax class accepts an identifier that determines 7 | ;; what subforms count as branches, and it parses out the leaves of the tree. It also makes the rank 8 | ;; of the tree (the number of levels in the tree) available as an attribute, so that the flattening 9 | ;; refactoring rules can avoid flattening trees that are already flat. 10 | 11 | 12 | (provide syntax-tree) 13 | 14 | 15 | (require rebellion/base/option 16 | rebellion/streaming/reducer 17 | rebellion/streaming/transducer 18 | syntax/parse) 19 | 20 | 21 | (module+ test 22 | (require rackunit 23 | (submod ".."))) 24 | 25 | 26 | ;@---------------------------------------------------------------------------------------------------- 27 | 28 | 29 | (define-syntax-class (syntax-tree branch-identifier) 30 | #:attributes ([leaf 1] rank) 31 | #:commit 32 | 33 | (pattern (id:id subtree ...) 34 | #:declare subtree (syntax-tree branch-identifier) 35 | #:when (free-identifier=? #'id branch-identifier) 36 | #:cut 37 | #:with (leaf ...) #'(subtree.leaf ... ...) 38 | #:attr rank (add1 (option-get (transduce (attribute subtree.rank) #:into (into-max)) 0))) 39 | 40 | (pattern other 41 | #:with (leaf ...) #'(other) 42 | #:attr rank 0)) 43 | 44 | 45 | (module+ test 46 | (test-case "expression-tree" 47 | 48 | (define (leaves stx) 49 | (syntax-parse stx 50 | [expr 51 | #:declare expr (syntax-tree #'or) 52 | (syntax->datum #'(expr.leaf ...))])) 53 | 54 | (define (rank stx) 55 | (syntax-parse stx 56 | [expr 57 | #:declare expr (syntax-tree #'or) 58 | (attribute expr.rank)])) 59 | 60 | (test-case "no outer form" 61 | (define stx #'foo) 62 | (check-equal? (leaves stx) '(foo)) 63 | (check-equal? (rank stx) 0)) 64 | 65 | (test-case "unrelated outer form" 66 | (define stx #'(foo a b c)) 67 | (check-equal? (leaves stx) '((foo a b c))) 68 | (check-equal? (rank stx) 0)) 69 | 70 | (test-case "empty outer form" 71 | (define stx #'(or)) 72 | (check-equal? (leaves stx) '()) 73 | (check-equal? (rank stx) 1)) 74 | 75 | (test-case "flat outer form" 76 | (define stx #'(or a b c)) 77 | (check-equal? (leaves stx) '(a b c)) 78 | (check-equal? (rank stx) 1)) 79 | 80 | (test-case "empty subform in empty outer form" 81 | (define stx #'(or (or))) 82 | (check-equal? (leaves stx) '()) 83 | (check-equal? (rank stx) 2)) 84 | 85 | (test-case "empty subform" 86 | (define stx #'(or a (or) b)) 87 | (check-equal? (leaves stx) '(a b)) 88 | (check-equal? (rank stx) 2)) 89 | 90 | (test-case "two singleton subforms" 91 | (define stx #'(or (or a) (or b))) 92 | (check-equal? (leaves stx) '(a b)) 93 | (check-equal? (rank stx) 2)) 94 | 95 | (test-case "two subforms" 96 | (define stx #'(or (or a b c) (or a b c))) 97 | (check-equal? (leaves stx) '(a b c a b c)) 98 | (check-equal? (rank stx) 2)) 99 | 100 | (test-case "deeply nested subforms" 101 | (define stx #'(or a (or b (or c (or d))))) 102 | (check-equal? (leaves stx) '(a b c d)) 103 | (check-equal? (rank stx) 4)))) 104 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-contract-migrations.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [legacy-contract-migrations refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | racket/syntax 14 | rebellion/private/static-name 15 | resyntax/base) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-refactoring-rule false/c-migration 22 | #:description "`false/c` is an alias for `#f` that exists for backwards compatibility." 23 | #:literals (false/c) 24 | false/c 25 | #false) 26 | 27 | 28 | (define-refactoring-rule symbols-migration 29 | #:description "`symbols` is equivalent to `or/c` and exists for backwards compatibility." 30 | #:literals (symbols) 31 | (symbols sym ...) 32 | (or/c sym ...)) 33 | 34 | 35 | (define-refactoring-rule vector-immutableof-migration 36 | #:description "`vector-immutableof` is a legacy form that is equivalent to `vectorof` with the\ 37 | `#:immutable` option" 38 | #:literals (vector-immutableof) 39 | (vector-immutableof c) 40 | (vectorof c #:immutable #true)) 41 | 42 | 43 | (define-refactoring-rule vector-immutable/c-migration 44 | #:description "`vector-immutable/c` is a legacy form that is equivalent to `vector/c` with the\ 45 | `#:immutable` option" 46 | #:literals (vector-immutable/c) 47 | (vector-immutable/c c ...) 48 | (vector/c c ... #:immutable #true)) 49 | 50 | 51 | (define-refactoring-rule box-immutable/c-migration 52 | #:description "`box-immutable/c` is a legacy form that is equivalent to `box/c` with the\ 53 | `#:immutable` option" 54 | #:literals (box-immutable/c) 55 | (box-immutable/c c) 56 | (box/c c #:immutable #true)) 57 | 58 | 59 | (define-refactoring-rule flat-contract-migration 60 | #:description "flat-contract is a legacy form for constructing contracts from predicates;\ 61 | predicates can be used directly as contracts now." 62 | #:literals (flat-contract) 63 | (flat-contract predicate) 64 | predicate) 65 | 66 | 67 | (define-refactoring-rule contract-struct-migration 68 | #:description "The `contract-struct` form is deprecated; use `struct` instead. Lazy struct\ 69 | contracts no longer require a separate struct declaration." 70 | #:literals (contract-struct) 71 | (contract-struct id fields) 72 | (struct id fields)) 73 | 74 | 75 | (define-refactoring-rule define-contract-struct-migration 76 | #:description "The `define-contract-struct` form is deprecated, use `struct` instead. Lazy struct\ 77 | contracts no longer require a separate struct declaration." 78 | #:literals (define-contract-struct) 79 | (define-contract-struct id fields) 80 | #:with make-id (format-id #'id "make-~a" #'id) 81 | (struct id fields #:extra-constructor-name make-id)) 82 | 83 | 84 | (define-refactoring-rule predicate/c-migration 85 | #:description 86 | "The `predicate/c` contract is less clear than a `->` contract and no longer improves performance." 87 | #:literals (predicate/c) 88 | predicate/c 89 | (-> any/c boolean?)) 90 | 91 | 92 | (define-refactoring-suite legacy-contract-migrations 93 | #:rules (box-immutable/c-migration 94 | contract-struct-migration 95 | define-contract-struct-migration 96 | false/c-migration 97 | flat-contract-migration 98 | predicate/c-migration 99 | symbols-migration 100 | vector-immutableof-migration 101 | vector-immutable/c-migration)) 102 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-syntax-migrations-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations legacy-syntax-migrations 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "the fifth argument to datum->syntax can be removed" 12 | ------------------------------ 13 | (define stx #'foo) 14 | (datum->syntax stx 'bar stx stx #'blah) 15 | ============================== 16 | (define stx #'foo) 17 | (datum->syntax stx 'bar stx stx) 18 | ------------------------------ 19 | 20 | 21 | test: "syntax-recertify can be removed" 22 | ------------------------------ 23 | (define stx #'foo) 24 | (define old-stx #'bar) 25 | (syntax-recertify stx old-stx (current-inspector) 'key) 26 | ============================== 27 | (define stx #'foo) 28 | (define old-stx #'bar) 29 | stx 30 | ------------------------------ 31 | 32 | 33 | test: "syntax-disarm can be removed" 34 | ------------------------------ 35 | (define stx #'foo) 36 | (syntax-disarm stx (current-inspector)) 37 | ============================== 38 | (define stx #'foo) 39 | stx 40 | ------------------------------ 41 | 42 | 43 | test: "syntax-rearm can be removed" 44 | ------------------------------ 45 | (define stx #'foo) 46 | (syntax-rearm stx #'bar) 47 | ============================== 48 | (define stx #'foo) 49 | stx 50 | ------------------------------ 51 | 52 | 53 | test: "syntax-protect can be removed" 54 | ------------------------------ 55 | (define stx #'foo) 56 | (syntax-protect stx) 57 | ============================== 58 | (define stx #'foo) 59 | stx 60 | ------------------------------ 61 | 62 | 63 | test: "for-clause-syntax-protect can be removed" 64 | ------------------------------ 65 | (require (for-template racket/base)) 66 | (define stx #'foo) 67 | (for-clause-syntax-protect stx) 68 | ============================== 69 | (require (for-template racket/base)) 70 | (define stx #'foo) 71 | stx 72 | ------------------------------ 73 | 74 | 75 | test: "syntax-local-match-introduce replaced with syntax-local-introduce" 76 | ------------------------------ 77 | (require (for-template racket/match)) 78 | (define (f) 79 | (syntax-local-match-introduce #'foo)) 80 | ============================== 81 | (require (for-template racket/match)) 82 | (define (f) 83 | (syntax-local-introduce #'foo)) 84 | ------------------------------ 85 | 86 | 87 | test: "syntax-local-provide-introduce replaced with syntax-local-introduce" 88 | ------------------------------ 89 | (require (for-template racket/provide-syntax)) 90 | (define (f) 91 | (syntax-local-provide-introduce #'foo)) 92 | ============================== 93 | (require (for-template racket/provide-syntax)) 94 | (define (f) 95 | (syntax-local-introduce #'foo)) 96 | ------------------------------ 97 | 98 | 99 | test: "syntax-local-require-introduce replaced with syntax-local-introduce" 100 | ------------------------------ 101 | (require (for-template racket/require-syntax)) 102 | (define (f) 103 | (syntax-local-require-introduce #'foo)) 104 | ============================== 105 | (require (for-template racket/require-syntax)) 106 | (define (f) 107 | (syntax-local-introduce #'foo)) 108 | ------------------------------ 109 | 110 | 111 | test: "syntax-local-syntax-parse-pattern-introduce replaced with syntax-local-introduce" 112 | ------------------------------ 113 | (require (for-template syntax/parse)) 114 | (define (f) 115 | (syntax-local-syntax-parse-pattern-introduce #'foo)) 116 | ============================== 117 | (require (for-template syntax/parse)) 118 | (define (f) 119 | (syntax-local-introduce #'foo)) 120 | ------------------------------ 121 | -------------------------------------------------------------------------------- /private/syntax-movement.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | ; Returns a map of sorted sets of syntax paths. Unfortunately I haven't implemented sorted map and 10 | ; set contracts. 11 | [syntax-movement-table (-> syntax? immutable-sorted-map?)])) 12 | 13 | 14 | (require racket/stream 15 | rebellion/collection/entry 16 | rebellion/collection/sorted-map 17 | rebellion/collection/sorted-set 18 | rebellion/streaming/transducer 19 | resyntax/private/syntax-neighbors 20 | resyntax/private/syntax-path 21 | resyntax/private/syntax-traversal 22 | syntax/parse) 23 | 24 | 25 | (module+ test 26 | (require (submod "..") 27 | rackunit)) 28 | 29 | 30 | ;@---------------------------------------------------------------------------------------------------- 31 | 32 | 33 | ; Traverses a syntax object `result-stx`, searching for all syntax objects that have a 34 | ; syntax-original-path, then returns a table mapping each original path to the set of paths in 35 | ; `result-stx` that corresponded to that original path. If `result-stx` is fully expanded syntax, this 36 | ; amounts to returning a table mapping each (path-based) position in the original unexpanded syntax to 37 | ; the set of positions in the fully expanded syntax which that original syntax expanded into. Note 38 | ; that each input path maps to a set of output paths instead of a single path because macros can 39 | ; duplicate forms. The returned table is in the form of an immutable sorted map of syntax paths to 40 | ; sorted sets of syntax paths. 41 | (define (syntax-movement-table result-stx) 42 | 43 | (define (search parent-stx [include-self? #true]) 44 | (syntax-search parent-stx 45 | [child 46 | #:do [(define child-stx (attribute child))] 47 | #:when (syntax-original-path child-stx) 48 | #:when (or include-self? (not (equal? child-stx parent-stx))) 49 | (stream-cons child-stx (search child-stx #false))])) 50 | 51 | (transduce (search (syntax-label-paths result-stx 'final-syntax-path)) 52 | (bisecting syntax-original-path 53 | (λ (stx) (syntax-property stx 'final-syntax-path))) 54 | (grouping (into-sorted-set syntax-path<=>)) 55 | #:into (into-sorted-map syntax-path<=>))) 56 | 57 | 58 | (module+ test 59 | (test-case "syntax-movement-table smoke test" 60 | (define orig-stx 61 | (syntax-label-original-paths 62 | #'(module foo racket/base 63 | (void)))) 64 | (define expanded-stx (expand orig-stx)) 65 | 66 | (define table (syntax-movement-table expanded-stx)) 67 | 68 | (define expected-table 69 | (sorted-map 70 | #:key-comparator syntax-path<=> 71 | 72 | ; (module ...) 73 | empty-syntax-path 74 | (sorted-set empty-syntax-path (syntax-path (list 3)) #:comparator syntax-path<=>) 75 | 76 | ; module 77 | (syntax-path (list 0)) 78 | (sorted-set (syntax-path (list 0)) #:comparator syntax-path<=>) 79 | 80 | ; foo 81 | (syntax-path (list 1)) 82 | (sorted-set (syntax-path (list 1)) #:comparator syntax-path<=>) 83 | 84 | ; racket/base 85 | (syntax-path (list 2)) 86 | (sorted-set (syntax-path (list 2)) #:comparator syntax-path<=>) 87 | 88 | ; (void) 89 | (syntax-path (list 3)) 90 | (sorted-set (syntax-path (list 3 2)) #:comparator syntax-path<=>) 91 | 92 | ; void 93 | (syntax-path (list 3 0)) 94 | (sorted-set (syntax-path (list 3 2 1)) #:comparator syntax-path<=>))) 95 | 96 | (check-equal? table expected-table))) 97 | -------------------------------------------------------------------------------- /.github/copilot-instructions.md: -------------------------------------------------------------------------------- 1 | # Overview 2 | 3 | This repository is a Racket package called Resyntax, which is a refactoring and 4 | static analysis tool for Racket code. It analyzes code using "refactoring 5 | rules" written in a domain-specific sublanguage of Racket and implemented using 6 | Racket's macro system. Resyntax then uses these rules to suggest ways people 7 | can improve their Racket code. See the [Resyntax documentation][1] and 8 | [Racket website][2] for more information. 9 | 10 | ## Adding New Refactoring Rules 11 | 12 | When trying to add a new refactoring rule to Resyntax's default 13 | recommendations, pay special attention to the sections in the Resyntax 14 | documentation on [what makes a good refactoring rule][3] and on 15 | [how to test refactoring rules][4]. Additionally, consider running Resyntax 16 | itself on the files you touch before opening a pull request: this can help you 17 | improve your code and ensure it follows Racket's best practices. Check the 18 | [documentation on the Resyntax command line tool][5] for more information on 19 | how to run it. Beware that Resyntax is *not* a `raco` command. Run it 20 | using `resyntax fix` or `resyntax analyze`, not `raco resyntax fix` or 21 | `raco resyntax analyze`. 22 | 23 | If you want to experiment with new refactoring rules you've created, consider 24 | doing so by cloning the [DrRacket][6], [Herbie][7], or [Typed Racket][8] 25 | repositories and running Resyntax on them. These repositories contain a lot 26 | of Racket code and are good candidates for testing new refactoring rules. 27 | 28 | ## Pull Request Style Conventions 29 | 30 | When creating a pull request, avoid being overly verbose in the pull 31 | request description. Keep descriptions to a single paragraph. If you need to 32 | include example code, limit it to one or two small blocks. Do not write 33 | lengthy, detailed explanations or documentation in the PR description. Avoid 34 | mentioning things that are obvious from the code changes themselves, such as 35 | lists of files changed. Reserve the PR description for only the most essential 36 | information, and err on the side of omission. There is nothing wrong with a 37 | pull request description that is just a single sentence and a mention of what 38 | issue number is being addressed. 39 | 40 | ## Code Coverage 41 | 42 | When writing tests, you can use the [`raco cover`][9] command to check the 43 | code coverage of your test cases. The command `raco cover path/to/file.rkt` 44 | will generate an HTML report showing what code is covered by running the 45 | indicated files. To check coverage for the whole repository, you can run 46 | this command: 47 | 48 | ```bash 49 | raco cover --suppress-log-execution --package resyntax 50 | ``` 51 | 52 | The `--suppress-log-execution` flag is necessary to avoid a bug in `raco cover` 53 | related to Racket's logging system. The `raco cover` tool has a few other sharp 54 | edges like this; see its documentation for more details. 55 | 56 | Pull requests should aim for high code coverage, and an integration with Coveralls 57 | is set up to help track coverage over time. You can view the Coveralls report for 58 | the entire repository at [this link][10]. 59 | 60 | [1]: https://docs.racket-lang.org/resyntax/ 61 | [2]: https://racket-lang.org/ 62 | [3]: https://docs.racket-lang.org/resyntax/Refactoring_Rules_and_Suites.html#%28part._.What_.Makes_a_.Good_.Refactoring_.Rule_%29 63 | [4]: https://docs.racket-lang.org/resyntax/Testing_Refactoring_Rules.html 64 | [5]: https://docs.racket-lang.org/resyntax/cli.html 65 | [6]: https://github.com/racket/drracket 66 | [7]: https://github.com/herbie-fp/herbie 67 | [8]: https://github.com/racket/typed-racket 68 | [9]: https://docs.racket-lang.org/cover/ 69 | [10]: https://coveralls.io/github/jackfirth/resyntax 70 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-struct-migrations-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations legacy-struct-migrations 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "define-struct without options" 12 | - (define-struct point (x y)) 13 | - (struct point (x y) #:extra-constructor-name make-point) 14 | 15 | 16 | test: "define-struct with simple options" 17 | - (define-struct point (x y) #:transparent #:mutable) 18 | - (struct point (x y) #:transparent #:mutable #:extra-constructor-name make-point) 19 | 20 | 21 | test: "define-struct with supertype" 22 | ---------------------------------------- 23 | (struct point ()) 24 | (define-struct (2d-point point) (x y)) 25 | ======================================== 26 | (struct point ()) 27 | (struct 2d-point point (x y) #:extra-constructor-name make-2d-point) 28 | ---------------------------------------- 29 | 30 | 31 | test: "define-struct with multi-form single-line options" 32 | ---------------------------------------- 33 | (define-struct point (x y) 34 | #:guard (λ (x y _) (values x y)) 35 | #:property prop:custom-print-quotable 36 | 'never 37 | #:inspector #false) 38 | ======================================== 39 | (struct point (x y) 40 | #:guard (λ (x y _) (values x y)) 41 | #:property prop:custom-print-quotable 42 | 'never 43 | #:inspector #false 44 | #:extra-constructor-name make-point) 45 | ---------------------------------------- 46 | 47 | 48 | test: "define-struct with multi-line options" 49 | ---------------------------------------- 50 | (define-struct point (x y) 51 | #:property prop:custom-write 52 | (λ (this out mode) (write-string "#" out))) 53 | ======================================== 54 | (struct point (x y) 55 | #:property prop:custom-write 56 | (λ (this out mode) (write-string "#" out)) 57 | #:extra-constructor-name make-point) 58 | ---------------------------------------- 59 | 60 | 61 | test: "define-struct with options with separating whitespace" 62 | ---------------------------------------- 63 | (define-struct point (x y) 64 | 65 | #:property prop:custom-write 66 | (λ (this out mode) (write-string "#" out)) 67 | 68 | #:guard (λ (x y _) (values x y))) 69 | ======================================== 70 | (struct point (x y) 71 | 72 | #:property prop:custom-write 73 | (λ (this out mode) (write-string "#" out)) 74 | 75 | #:guard (λ (x y _) (values x y)) 76 | #:extra-constructor-name make-point) 77 | ---------------------------------------- 78 | 79 | 80 | test: "define-struct with field comments" 81 | ---------------------------------------- 82 | (define-struct point 83 | (x ;; The X coordinate of the point 84 | y ;; The Y coordinate of the point 85 | )) 86 | ======================================== 87 | (struct point 88 | (x ;; The X coordinate of the point 89 | y ;; The Y coordinate of the point 90 | ) 91 | #:extra-constructor-name make-point) 92 | ---------------------------------------- 93 | 94 | 95 | test: "define-struct with comments between options" 96 | ---------------------------------------- 97 | (define-struct point (x y) 98 | 99 | ;; Custom write implementation 100 | #:property prop:custom-write 101 | (λ (this out mode) (write-string "#" out)) 102 | 103 | ;; Field guard 104 | #:guard (λ (x y _) (values x y))) 105 | ======================================== 106 | (struct point (x y) 107 | 108 | ;; Custom write implementation 109 | #:property prop:custom-write 110 | (λ (this out mode) (write-string "#" out)) 111 | 112 | ;; Field guard 113 | #:guard (λ (x y _) (values x y)) 114 | #:extra-constructor-name make-point) 115 | ---------------------------------------- 116 | -------------------------------------------------------------------------------- /default-recommendations/mutability-predicates.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [mutability-predicates refactoring-suite?])) 10 | 11 | 12 | (require racket/mutability 13 | resyntax/base 14 | syntax/parse) 15 | 16 | 17 | ;@---------------------------------------------------------------------------------------------------- 18 | 19 | 20 | (define-refactoring-rule hash-and-immutable-to-immutable-hash 21 | #:description "This contract is equivalent to the `immutable-hash?` predicate." 22 | #:literals (and/c hash? immutable?) 23 | (~or (and/c hash? immutable?) (and/c immutable? hash?)) 24 | immutable-hash?) 25 | 26 | 27 | (define-refactoring-rule string-and-immutable-to-immutable-string 28 | #:description "This contract is equivalent to the `immutable-string?` predicate." 29 | #:literals (and/c string? immutable?) 30 | (~or (and/c string? immutable?) (and/c immutable? string?)) 31 | immutable-string?) 32 | 33 | 34 | (define-refactoring-rule bytes-and-immutable-to-immutable-bytes 35 | #:description "This contract is equivalent to the `immutable-bytes?` predicate." 36 | #:literals (and/c bytes? immutable?) 37 | (~or (and/c bytes? immutable?) (and/c immutable? bytes?)) 38 | immutable-bytes?) 39 | 40 | 41 | (define-refactoring-rule vector-and-immutable-to-immutable-vector 42 | #:description "This contract is equivalent to the `immutable-vector?` predicate." 43 | #:literals (and/c vector? immutable?) 44 | (~or (and/c vector? immutable?) (and/c immutable? vector?)) 45 | immutable-vector?) 46 | 47 | 48 | (define-refactoring-rule box-and-immutable-to-immutable-box 49 | #:description "This contract is equivalent to the `immutable-box?` predicate." 50 | #:literals (and/c box? immutable?) 51 | (~or (and/c box? immutable?) (and/c immutable? box?)) 52 | immutable-box?) 53 | 54 | 55 | (define-refactoring-rule hash-and-mutable-to-mutable-hash 56 | #:description "This contract is equivalent to the `mutable-hash?` predicate." 57 | #:literals (and/c hash? not/c immutable?) 58 | (~or (and/c hash? (not/c immutable?)) (and/c (not/c immutable?) hash?)) 59 | mutable-hash?) 60 | 61 | 62 | (define-refactoring-rule string-and-mutable-to-mutable-string 63 | #:description "This contract is equivalent to the `mutable-string?` predicate." 64 | #:literals (and/c string? not/c immutable?) 65 | (~or (and/c string? (not/c immutable?)) (and/c (not/c immutable?) string?)) 66 | mutable-string?) 67 | 68 | 69 | (define-refactoring-rule bytes-and-mutable-to-mutable-bytes 70 | #:description "This contract is equivalent to the `mutable-bytes?` predicate." 71 | #:literals (and/c bytes? not/c immutable?) 72 | (~or (and/c bytes? (not/c immutable?)) (and/c (not/c immutable?) bytes?)) 73 | mutable-bytes?) 74 | 75 | 76 | (define-refactoring-rule vector-and-mutable-to-mutable-vector 77 | #:description "This contract is equivalent to the `mutable-vector?` predicate." 78 | #:literals (and/c vector? not/c immutable?) 79 | (~or (and/c vector? (not/c immutable?)) (and/c (not/c immutable?) vector?)) 80 | mutable-vector?) 81 | 82 | 83 | (define-refactoring-rule box-and-mutable-to-mutable-box 84 | #:description "This contract is equivalent to the `mutable-box?` predicate." 85 | #:literals (and/c box? not/c immutable?) 86 | (~or (and/c box? (not/c immutable?)) (and/c (not/c immutable?) box?)) 87 | mutable-box?) 88 | 89 | 90 | (define-refactoring-suite mutability-predicates 91 | #:rules (hash-and-immutable-to-immutable-hash 92 | string-and-immutable-to-immutable-string 93 | bytes-and-immutable-to-immutable-bytes 94 | vector-and-immutable-to-immutable-vector 95 | box-and-immutable-to-immutable-box 96 | hash-and-mutable-to-mutable-hash 97 | string-and-mutable-to-mutable-string 98 | bytes-and-mutable-to-mutable-bytes 99 | vector-and-mutable-to-mutable-vector 100 | box-and-mutable-to-mutable-box)) 101 | -------------------------------------------------------------------------------- /private/code-snippet.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [code-snippet? (-> any/c boolean?)] 10 | [code-snippet 11 | (-> string? exact-nonnegative-integer? exact-positive-integer? code-snippet?)] 12 | [code-snippet-raw-text (-> code-snippet? immutable-string?)] 13 | [code-snippet-start-column (-> code-snippet? exact-nonnegative-integer?)] 14 | [code-snippet-start-line (-> code-snippet? exact-positive-integer?)] 15 | [code-snippet-end-line (-> code-snippet? exact-positive-integer?)])) 16 | 17 | 18 | (require racket/format 19 | racket/math 20 | racket/sequence 21 | racket/string 22 | rebellion/base/immutable-string) 23 | 24 | 25 | (module+ test 26 | (require rackunit 27 | rebellion/private/static-name 28 | (submod ".."))) 29 | 30 | 31 | ;@---------------------------------------------------------------------------------------------------- 32 | 33 | 34 | (struct code-snippet (raw-text start-column start-line) 35 | #:transparent 36 | 37 | #:guard 38 | (λ (raw-text start-column start-line _) 39 | (values (string->immutable-string raw-text) start-column start-line)) 40 | 41 | #:methods gen:custom-write 42 | [(define (write-proc this out mode) 43 | (define end-line (code-snippet-end-line this)) 44 | (for ([line (in-lines (open-input-string (code-snippet-raw-text this)))] 45 | [n (in-naturals)]) 46 | (define line-number-string 47 | (~a (+ n (code-snippet-start-line this)) #:min-width (digit-count end-line))) 48 | (write-string line-number-string out) 49 | (write-string " " out) 50 | (cond 51 | [(zero? n) (write-string line out)] 52 | [else 53 | (define leading-indentation (make-string (code-snippet-start-column this) #\space)) 54 | (write-string (string-replace line leading-indentation "" #:all? #false) out)]) 55 | (newline out)))]) 56 | 57 | ; code-snippet-start-line and code-snippet-end-line give an inclusive-exclusive range; that is, 58 | ; a one-line snippet on line 10 would have start and end lines of 10 and 11, respectively. 59 | (define (code-snippet-end-line snippet) 60 | (define line-count (sequence-length (in-lines (open-input-string (code-snippet-raw-text snippet))))) 61 | (+ (code-snippet-start-line snippet) line-count)) 62 | 63 | 64 | (module+ test 65 | (test-case (name-string code-snippet-end-line) 66 | (test-case "end-line is one greater than the number of the last line in the snippet" 67 | (define snippet (code-snippet "(+\n 1\n 2\n 3)" 0 6)) 68 | (check-equal? (code-snippet-end-line snippet) 10))) 69 | 70 | (test-case (name-string code-snippet) 71 | (test-case "one-line snippet" 72 | (define snippet (code-snippet "(+ 1 2 3)" 0 1)) 73 | (check-equal? (~a snippet) "1 (+ 1 2 3)\n")) 74 | 75 | (test-case "multiline snippet" 76 | (define snippet (code-snippet "(define (f x)\n (+ x x))" 0 1)) 77 | (check-equal? (~a snippet) "1 (define (f x)\n2 (+ x x))\n")) 78 | 79 | (test-case "indented snippet" 80 | (define snippet (code-snippet "(+ 1 2 3)" 10 1)) 81 | (check-equal? (~a snippet) "1 (+ 1 2 3)\n")) 82 | 83 | (test-case "indented multiline snippet" 84 | (define snippet (code-snippet "(define (f x)\n (+ x x))" 10 1)) 85 | (check-equal? (~a snippet) "1 (define (f x)\n2 (+ x x))\n")) 86 | 87 | (test-case "snippet with line numbers of different digit counts" 88 | (define snippet (code-snippet "(+ 1 2 3)\n(+ 4 5 6)" 0 99)) 89 | (check-equal? (~a snippet) "99 (+ 1 2 3)\n100 (+ 4 5 6)\n")))) 90 | 91 | 92 | (define (digit-count n) 93 | (add1 (exact-floor (log n 10)))) 94 | 95 | 96 | (module+ test 97 | (test-case (name-string digit-count) 98 | (check-equal? (digit-count 1) 1) 99 | (check-equal? (digit-count 123) 3) 100 | (check-equal? (digit-count 10000) 5) 101 | (check-equal? (digit-count 10001) 5) 102 | (check-equal? (digit-count 9999) 4))) 103 | -------------------------------------------------------------------------------- /default-recommendations/gap-preservation-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations/gap-preservation gap-preservation-rules 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "comments preserved in splice when form inserted at front" 12 | ----------------------------------- 13 | (define (code insert-foo-first a b) 14 | (insert-foo-first a 15 | ; comment 16 | b)) 17 | =================================== 18 | (define (code insert-foo-first a b) 19 | ("foo" a 20 | ; comment 21 | b)) 22 | ----------------------------------- 23 | 24 | 25 | test: "later comments preserved in splice when form inserted after first" 26 | ----------------------------------- 27 | (define (code insert-foo-second a b c) 28 | (insert-foo-second a 29 | b 30 | ; preserved comment 31 | c)) 32 | =================================== 33 | (define (code insert-foo-second a b c) 34 | (a "foo" 35 | b 36 | ; preserved comment 37 | c)) 38 | ----------------------------------- 39 | 40 | 41 | no-change-test: "not refactorable when comment dropped due to inserted form" 42 | ----------------------------------- 43 | (define (code insert-foo-second a b c) 44 | (insert-foo-second a 45 | ; dropped comment 46 | b 47 | c)) 48 | ----------------------------------- 49 | 50 | 51 | test: "comments preserved in splice when form inserted at end" 52 | ----------------------------------- 53 | (define (code insert-foo-last a b c) 54 | (insert-foo-last a 55 | b 56 | ; comment 57 | c)) 58 | =================================== 59 | (define (code insert-foo-last a b c) 60 | (a b 61 | ; comment 62 | c 63 | "foo")) 64 | ----------------------------------- 65 | 66 | 67 | test: "comments preserved in splice when first form replaced" 68 | ----------------------------------- 69 | (define (code replace-first-with-foo a b c) 70 | (replace-first-with-foo a 71 | ; comment after 72 | b 73 | c)) 74 | =================================== 75 | (define (code replace-first-with-foo a b c) 76 | ; comment after 77 | ("foo" b c)) 78 | ----------------------------------- 79 | 80 | 81 | test: "comments preserved in splice when second form replaced" 82 | ----------------------------------- 83 | (define (code replace-second-with-foo a b c) 84 | (replace-second-with-foo a 85 | ; comment before 86 | b 87 | ; comment after 88 | c)) 89 | =================================== 90 | (define (code replace-second-with-foo a b c) 91 | ; comment before 92 | (a "foo" 93 | ; comment after 94 | c)) 95 | ----------------------------------- 96 | 97 | 98 | test: "comments preserved in splice when last form replaced" 99 | ----------------------------------- 100 | (define (code replace-last-with-foo a b c) 101 | (replace-last-with-foo a 102 | b 103 | ; comment before 104 | c)) 105 | =================================== 106 | (define (code replace-last-with-foo a b c) 107 | (a b 108 | ; comment before 109 | "foo")) 110 | ----------------------------------- 111 | 112 | 113 | test: "comments preserved in splice when first and last forms replaced" 114 | ----------------------------------- 115 | (define (code replace-first-and-last-with-foo a b c) 116 | (replace-first-and-last-with-foo a 117 | ; comment after 118 | b 119 | ; comment before 120 | c)) 121 | =================================== 122 | (define (code replace-first-and-last-with-foo a b c) 123 | ; comment after 124 | ("foo" b 125 | ; comment before 126 | "foo")) 127 | ----------------------------------- 128 | -------------------------------------------------------------------------------- /default-recommendations/private/pure-expression.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (provide pure-expression) 5 | 6 | 7 | (require racket/list 8 | resyntax/default-recommendations/private/literal-constant 9 | syntax/parse) 10 | 11 | 12 | ;@---------------------------------------------------------------------------------------------------- 13 | 14 | 15 | ; These are all the pure functions defined in docs.racket-lang.org/reference/generic-numbers.html 16 | ; The racket/math ones aren't included because I haven't bothered to do that yet. 17 | (define-literal-set pure-numeric-functions 18 | (+ 19 | - 20 | * 21 | / 22 | quotient 23 | remainder 24 | quotient/remainder 25 | modulo 26 | add1 27 | sub1 28 | abs 29 | max 30 | min 31 | gcd 32 | lcm 33 | round 34 | floor 35 | ceiling 36 | truncate 37 | numerator 38 | denominator 39 | rationalize 40 | = 41 | < 42 | <= 43 | > 44 | >= 45 | sqrt 46 | integer-sqrt 47 | integer-sqrt/remainder 48 | expt 49 | exp 50 | log 51 | sin 52 | cos 53 | tan 54 | asin 55 | acos 56 | atan 57 | make-rectangular 58 | make-polar 59 | real-part 60 | imag-part 61 | magnitude 62 | angle 63 | bitwise-ior 64 | bitwise-and 65 | bitwise-xor 66 | bitwise-not 67 | bitwise-bit-set? 68 | bitwise-first-bit-set 69 | bitwise-bit-field 70 | arithmetic-shift 71 | integer-length 72 | pseudo-random-generator? 73 | pseudo-random-generator-vector? 74 | number->string 75 | string->number 76 | real->decimal-string 77 | integer-bytes->integer 78 | floating-point-bytes->real)) 79 | 80 | 81 | ; These are most of the pure functions defined in docs.racket-lang.org/reference/pairs.html 82 | ; Functions that take other functions as arguments aren't included because those are only pure if the 83 | ; given argument functions are pure. 84 | (define-literal-set pure-list-functions 85 | (pair? 86 | null? 87 | cons 88 | car 89 | cdr 90 | list? 91 | list 92 | list* 93 | length 94 | list-ref 95 | list-tail 96 | append 97 | reverse 98 | remq 99 | remv 100 | remw 101 | remq* 102 | remv* 103 | remw* 104 | memw 105 | memv 106 | memq 107 | assw 108 | assv 109 | assq 110 | caar 111 | cadr 112 | cdar 113 | cddr 114 | caaar 115 | caadr 116 | cadar 117 | caddr 118 | cdaar 119 | cdadr 120 | cddar 121 | cdddr 122 | caaaar 123 | caaadr 124 | caadar 125 | caaddr 126 | cadaar 127 | cadadr 128 | caddar 129 | cadddr 130 | cdaaar 131 | cdaadr 132 | cdadar 133 | cdaddr 134 | cddaar 135 | cddadr 136 | cdddar 137 | cddddr 138 | cons? 139 | empty? 140 | first 141 | rest 142 | second 143 | third 144 | fourth 145 | fifth 146 | sixth 147 | seventh 148 | eighth 149 | ninth 150 | tenth 151 | eleventh 152 | twelfth 153 | thirteenth 154 | fourteenth 155 | fifteenth 156 | last 157 | last-pair 158 | make-list 159 | list-set 160 | take 161 | drop 162 | split-at 163 | take-right 164 | drop-right 165 | split-at-right 166 | add-between 167 | append* 168 | flatten 169 | range 170 | inclusive-range 171 | combinations 172 | in-combinations 173 | permutations 174 | in-permutations 175 | cartesian-product)) 176 | 177 | 178 | (define-literal-set pure-functions 179 | #:literal-sets (pure-numeric-functions pure-list-functions) 180 | (hash-ref)) 181 | 182 | 183 | (define-syntax-class pure-expression 184 | #:literals (and or if cond when unless) 185 | (pattern :literal-constant) 186 | (pattern :id) 187 | (pattern (f:id arg:pure-expression ...) 188 | #:when ((literal-set->predicate pure-functions) (attribute f))) 189 | (pattern ((~or and or if when unless) subexpr:pure-expression ...)) 190 | (pattern (cond clause:cond-clause ...))) 191 | 192 | 193 | (define-syntax-class cond-clause 194 | #:literals (else) 195 | (pattern [test:pure-expression expr:pure-expression ...]) 196 | (pattern [else expr:pure-expression ...])) 197 | -------------------------------------------------------------------------------- /default-recommendations/legacy/legacy-syntax-migrations.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [legacy-syntax-migrations refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | (for-template racket/base 14 | racket/match 15 | racket/provide-syntax 16 | racket/require-syntax 17 | syntax/parse) 18 | rebellion/private/static-name 19 | resyntax/base 20 | resyntax/private/syntax-neighbors 21 | resyntax/private/syntax-replacement 22 | syntax/parse) 23 | 24 | 25 | ;@---------------------------------------------------------------------------------------------------- 26 | 27 | 28 | (define-refactoring-rule datum->syntax-migration 29 | #:description "The fifth argument to `datum->syntax` is ignored." 30 | #:literals (datum->syntax) 31 | ((~and id datum->syntax) ctxt v srcloc prop ignored) 32 | (id ctxt v srcloc prop)) 33 | 34 | 35 | (define-refactoring-rule syntax-recertify-migration 36 | #:description "The `syntax-recertify` function is a legacy function that does nothing." 37 | #:literals (syntax-recertify) 38 | (syntax-recertify stx _ _ _) 39 | stx) 40 | 41 | 42 | (define-refactoring-rule syntax-disarm-migration 43 | #:description "The `syntax-disarm` function is a legacy function that does nothing." 44 | #:literals (syntax-disarm) 45 | (syntax-disarm stx _) 46 | stx) 47 | 48 | 49 | (define-refactoring-rule syntax-rearm-migration 50 | #:description "The `syntax-rearm` function is a legacy function that does nothing." 51 | #:literals (syntax-rearm) 52 | (syntax-rearm stx _ ...) 53 | stx) 54 | 55 | 56 | (define-refactoring-rule syntax-protect-migration 57 | #:description "The `syntax-protect` function is a legacy function that does nothing." 58 | #:literals (syntax-protect) 59 | (syntax-protect stx) 60 | stx) 61 | 62 | 63 | (define-refactoring-rule for-clause-syntax-protect-migration 64 | #:description "The `for-clause-syntax-protect` function is a legacy function that does nothing." 65 | #:literals (for-clause-syntax-protect) 66 | (for-clause-syntax-protect stx) 67 | stx) 68 | 69 | 70 | (define-refactoring-rule syntax-local-match-introduce-migration 71 | #:description 72 | "The `syntax-local-match-introduce` function is a legacy function that's equivalent to\ 73 | `syntax-local-introduce`." 74 | #:literals (syntax-local-match-introduce) 75 | (id:syntax-local-match-introduce stx) 76 | ((~replacement syntax-local-introduce #:original id) stx)) 77 | 78 | 79 | (define-refactoring-rule syntax-local-provide-introduce-migration 80 | #:description 81 | "The `syntax-local-provide-introduce` function is a legacy function that's equivalent to\ 82 | `syntax-local-introduce`." 83 | #:literals (syntax-local-provide-introduce) 84 | (id:syntax-local-provide-introduce stx) 85 | ((~replacement syntax-local-introduce #:original id) stx)) 86 | 87 | 88 | (define-refactoring-rule syntax-local-require-introduce-migration 89 | #:description 90 | "The `syntax-local-require-introduce` function is a legacy function that's equivalent to\ 91 | `syntax-local-introduce`." 92 | #:literals (syntax-local-require-introduce) 93 | (id:syntax-local-require-introduce stx) 94 | ((~replacement syntax-local-introduce #:original id) stx)) 95 | 96 | 97 | (define-refactoring-rule syntax-local-syntax-parse-pattern-introduce-migration 98 | #:description 99 | "The `syntax-local-syntax-parse-pattern-introduce` function is a legacy function that's equivalent\ 100 | to `syntax-local-introduce`." 101 | #:literals (syntax-local-syntax-parse-pattern-introduce) 102 | (id:syntax-local-syntax-parse-pattern-introduce stx) 103 | ((~replacement syntax-local-introduce #:original id) stx)) 104 | 105 | 106 | (define-refactoring-suite legacy-syntax-migrations 107 | #:rules (datum->syntax-migration 108 | for-clause-syntax-protect-migration 109 | syntax-disarm-migration 110 | syntax-local-match-introduce-migration 111 | syntax-local-provide-introduce-migration 112 | syntax-local-require-introduce-migration 113 | syntax-local-syntax-parse-pattern-introduce-migration 114 | syntax-protect-migration 115 | syntax-rearm-migration 116 | syntax-recertify-migration)) 117 | -------------------------------------------------------------------------------- /default-recommendations/let-replacement/match-let-replacement-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations match-let-replacement 5 | 6 | 7 | header: 8 | ------------------------------ 9 | #lang racket/base 10 | (require racket/match) 11 | ------------------------------ 12 | 13 | 14 | test: "single-binding match-let expressions can be replaced with match-define" 15 | ------------------------------ 16 | (define (foo x) 17 | (displayln "foo?") 18 | (match-let ([(list a b c) x]) 19 | (displayln "foo!") 20 | (+ a b c))) 21 | ============================== 22 | (define (foo x) 23 | (displayln "foo?") 24 | (match-define (list a b c) x) 25 | (displayln "foo!") 26 | (+ a b c)) 27 | ------------------------------ 28 | 29 | 30 | test: "single-binding match-let* expressions can be replaced with match-define" 31 | ------------------------------ 32 | (define (foo x) 33 | (displayln "foo?") 34 | (match-let* ([(list a b c) x]) 35 | (displayln "foo!") 36 | (+ a b c))) 37 | ============================== 38 | (define (foo x) 39 | (displayln "foo?") 40 | (match-define (list a b c) x) 41 | (displayln "foo!") 42 | (+ a b c)) 43 | ------------------------------ 44 | 45 | 46 | test: "single-binding match-letrec expressions can be replaced with match-define" 47 | ------------------------------ 48 | (define (foo x) 49 | (displayln "foo?") 50 | (match-letrec ([(list a b c) x]) 51 | (displayln "foo!") 52 | (+ a b c))) 53 | ============================== 54 | (define (foo x) 55 | (displayln "foo?") 56 | (match-define (list a b c) x) 57 | (displayln "foo!") 58 | (+ a b c)) 59 | ------------------------------ 60 | 61 | 62 | test: "migrating single-binding match-let expressions to match-define doesn't reformat context" 63 | ------------------------------ 64 | (define (foo x) 65 | 66 | ( displayln "foo?" ) 67 | 68 | (match-let ([(list a b c) x]) 69 | (displayln "foo!") 70 | (+ a b c))) 71 | ============================== 72 | (define (foo x) 73 | 74 | ( displayln "foo?" ) 75 | 76 | (match-define (list a b c) x) 77 | (displayln "foo!") 78 | (+ a b c)) 79 | ------------------------------ 80 | 81 | 82 | test: "migrating single-binding match-let expressions in single-form contexts does reformat" 83 | ------------------------------ 84 | (map (λ (x) (match-let ([(list a b c) x]) (+ a b c))) 85 | (list (list 1 2 3) (list 4 5 6))) 86 | ============================== 87 | (map (λ (x) 88 | (match-define (list a b c) x) 89 | (+ a b c)) 90 | (list (list 1 2 3) (list 4 5 6))) 91 | ------------------------------ 92 | 93 | 94 | test: "single-binding match-let expressions inside cond can be replaced with match-define" 95 | ------------------------------ 96 | (define (foo x condition) 97 | (cond 98 | [condition 99 | (displayln "foo?") 100 | (match-let ([(list a b c) x]) 101 | (displayln "foo!") 102 | (+ a b c))] 103 | [else (displayln "else")])) 104 | ============================== 105 | (define (foo x condition) 106 | (cond 107 | [condition 108 | (displayln "foo?") 109 | (match-define (list a b c) x) 110 | (displayln "foo!") 111 | (+ a b c)] 112 | [else (displayln "else")])) 113 | ------------------------------ 114 | 115 | 116 | no-change-test: 117 | "single-binding match-let not migratable when pattern bindings conflict with surrounding context" 118 | ------------------------------ 119 | (define (foo x) 120 | (define a 42) 121 | (match-let ([(list a b c) x]) 122 | a)) 123 | ------------------------------ 124 | 125 | 126 | no-change-test: 127 | "single-binding match-let not migratable when pattern would bind subject expression" 128 | ------------------------------ 129 | (define (foo x) 130 | (match-let ([(list x y z) x]) 131 | x)) 132 | ------------------------------ 133 | 134 | 135 | no-change-test: "multiple-binding match-let should not be converted to match-define" 136 | ------------------------------ 137 | (define (foo x y) 138 | (match-let ([(list a b) x] 139 | [(list c d) y]) 140 | (+ a b c d))) 141 | ------------------------------ 142 | 143 | 144 | no-change-test: "multiple-binding match-let* should not be converted to match-define" 145 | ------------------------------ 146 | (define (foo x) 147 | (match-let* ([(list a b) x] 148 | [(list c d) (list a b)]) 149 | (+ a b c d))) 150 | ------------------------------ 151 | -------------------------------------------------------------------------------- /default-recommendations/boolean-shortcuts-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | 3 | 4 | require: resyntax/default-recommendations boolean-shortcuts 5 | 6 | 7 | header: 8 | - #lang racket/base 9 | 10 | 11 | test: "nested ors can be flattened" 12 | - (or 1 2 (or 3 4)) 13 | - (or 1 2 3 4) 14 | 15 | 16 | no-change-test: "flat ors can't be flattened" 17 | - (or 1 2 3) 18 | 19 | 20 | test: "multiple nested ors can be flattened at once" 21 | - (or (or 1 2) (or 3 4) (or 5 6)) 22 | - (or 1 2 3 4 5 6) 23 | 24 | 25 | test: "deeply nested ors can be flattened in one pass" 26 | - (or 1 (or 2 (or 3 (or 4 5 6)))) 27 | - (or 1 2 3 4 5 6) 28 | 29 | 30 | no-change-test: "multiline nested ors can't be flattened" 31 | ------------------------------ 32 | (or 1 33 | (or 2 3)) 34 | ------------------------------ 35 | 36 | 37 | test: "nested ands can be flattened" 38 | - (and 1 2 (and 3 4)) 39 | - (and 1 2 3 4) 40 | 41 | 42 | no-change-test: "flat ands can't be flattened" 43 | - (and 1 2 3) 44 | 45 | 46 | test: "multiple nested ands can be flattened at once" 47 | - (and (and 1 2) (and 3 4) (and 5 6)) 48 | - (and 1 2 3 4 5 6) 49 | 50 | 51 | test: "deeply nested ands can be flattened in one pass" 52 | - (and 1 (and 2 (and 3 (and 4 5 6)))) 53 | - (and 1 2 3 4 5 6) 54 | 55 | 56 | no-change-test: "multiline nested ands can't be flattened" 57 | ------------------------------ 58 | (and 1 59 | (and 2 3)) 60 | ------------------------------ 61 | 62 | 63 | test: "nested ors interspersed with ands can be flattened" 64 | - (or (or 1 2) (and 3 4) (or 5 6)) 65 | - (or 1 2 (and 3 4) 5 6) 66 | 67 | 68 | test: "nested ands interspersed with ors can be flattened" 69 | - (and (and 1 2) (or 3 4) (and 5 6)) 70 | - (and 1 2 (or 3 4) 5 6) 71 | 72 | 73 | test: "refactoring an expression doesn't affect formatting of unrefactored code" 74 | ---------------------------------------- 75 | ( displayln "foo" ) 76 | (or 1 (or 2 3)) 77 | ( displayln "bar" ) 78 | ======================================== 79 | ( displayln "foo" ) 80 | (or 1 2 3) 81 | ( displayln "bar" ) 82 | ---------------------------------------- 83 | 84 | 85 | test: "using if to convert a boolean expression to a boolean can be removed" 86 | - (if (string? "foo") #true #false) 87 | - (string? "foo") 88 | 89 | 90 | no-change-test: 91 | "using if to convert a boolean expression to a boolean can't be removed when if is rebound" 92 | ------------------------------ 93 | (define (if a b c) 94 | (displayln "You thought I was an if expression? Fool!")) 95 | (if (string? "foo") #true #false) 96 | ------------------------------ 97 | 98 | 99 | test: "if else false can be refactored to use and" 100 | - (if (+ 4 10) (* 4 9) #false) 101 | - (and (+ 4 10) (* 4 9)) 102 | 103 | 104 | test: "using if to convert a non-boolean expression can be refactored to use and" 105 | - (if 4 #true #false) 106 | - (and 4 #true) 107 | 108 | 109 | test: "if then false else true can be refactored to use not" 110 | - (if 4 #false #true) 111 | - (not 4) 112 | 113 | 114 | test: "when not can be refactored to use unless" 115 | ------------------------------ 116 | (when (not 'foo) 117 | (displayln "not foo")) 118 | ============================== 119 | (unless 'foo 120 | (displayln "not foo")) 121 | ------------------------------ 122 | 123 | 124 | test: "refactoring negated when into unless preserves comments" 125 | ------------------------------ 126 | ; comment before 127 | (when 128 | ; strangely positioned comment before 129 | (not 'foo) 130 | ; comment after 131 | (displayln "not foo")) 132 | ============================== 133 | ; comment before 134 | ; strangely positioned comment before 135 | (unless 'foo 136 | ; comment after 137 | (displayln "not foo")) 138 | ------------------------------ 139 | 140 | 141 | test: "unless not can be refactored to use when" 142 | ------------------------------ 143 | (unless (not 'foo) 144 | (displayln "foo")) 145 | ============================== 146 | (when 'foo 147 | (displayln "foo")) 148 | ------------------------------ 149 | 150 | 151 | test: "refactoring negated unless into when preserves comments" 152 | ------------------------------ 153 | ; comment before 154 | (unless 155 | ; strangely positioned comment before 156 | (not 'foo) 157 | ; comment after 158 | (displayln "foo")) 159 | ============================== 160 | ; comment before 161 | ; strangely positioned comment before 162 | (when 'foo 163 | ; comment after 164 | (displayln "foo")) 165 | ------------------------------ 166 | -------------------------------------------------------------------------------- /default-recommendations/comparison-shortcuts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | 4 | (require racket/contract/base) 5 | 6 | 7 | (provide 8 | (contract-out 9 | [comparison-shortcuts refactoring-suite?])) 10 | 11 | 12 | (require (for-syntax racket/base) 13 | rebellion/private/static-name 14 | resyntax/base 15 | syntax/parse) 16 | 17 | 18 | ;@---------------------------------------------------------------------------------------------------- 19 | 20 | 21 | (define-syntax-class comparison-of-difference-and-zero 22 | #:attributes (direct-comparison) 23 | #:literals (- > < >= <=) 24 | (pattern (> (- x y) 0) #:with direct-comparison #'(> x y)) 25 | (pattern (< (- x y) 0) #:with direct-comparison #'(< x y)) 26 | (pattern (>= (- x y) 0) #:with direct-comparison #'(>= x y)) 27 | (pattern (<= (- x y) 0) #:with direct-comparison #'(<= x y)) 28 | (pattern (> 0 (- x y)) #:with direct-comparison #'(< x y)) 29 | (pattern (< 0 (- x y)) #:with direct-comparison #'(> x y)) 30 | (pattern (>= 0 (- x y)) #:with direct-comparison #'(<= x y)) 31 | (pattern (<= 0 (- x y)) #:with direct-comparison #'(>= x y))) 32 | 33 | 34 | (define-refactoring-rule comparison-of-difference-and-zero-to-direct-comparison 35 | #:description "This comparison can be replaced with a simpler, more direct comparison." 36 | comparison:comparison-of-difference-and-zero 37 | comparison.direct-comparison) 38 | 39 | 40 | (define-syntax-class two-exclusive-comparisons 41 | #:attributes (x lower-bound upper-bound) 42 | #:literals (and > <) 43 | 44 | (pattern (and (< x:id upper-bound:expr) (> x2:id lower-bound:expr)) 45 | #:when (free-identifier=? #'x #'x2)) 46 | 47 | (pattern (and (> x:id lower-bound:expr) (< x2:id upper-bound:expr)) 48 | #:when (free-identifier=? #'x #'x2)) 49 | 50 | (pattern (and (< x:id upper-bound:expr) (< lower-bound:expr x2:id)) 51 | #:when (free-identifier=? #'x #'x2)) 52 | 53 | (pattern (and (< lower-bound:expr x:id) (< x2:id upper-bound:expr)) 54 | #:when (free-identifier=? #'x #'x2)) 55 | 56 | (pattern (and (> upper-bound:expr x:id) (> x2:id lower-bound:expr)) 57 | #:when (free-identifier=? #'x #'x2)) 58 | 59 | (pattern (and (> x:id lower-bound:expr) (> upper-bound:expr x2:id)) 60 | #:when (free-identifier=? #'x #'x2)) 61 | 62 | (pattern (and (> upper-bound:expr x:id) (< lower-bound:expr x2:id)) 63 | #:when (free-identifier=? #'x #'x2)) 64 | 65 | (pattern (and (< lower-bound:expr x:id) (> upper-bound:expr x2:id)) 66 | #:when (free-identifier=? #'x #'x2))) 67 | 68 | 69 | (define-syntax-class two-inclusive-comparisons 70 | #:attributes (x lower-bound upper-bound) 71 | #:literals (and >= <=) 72 | 73 | (pattern (and (<= x:id upper-bound:expr) (>= x2:id lower-bound:expr)) 74 | #:when (free-identifier=? #'x #'x2)) 75 | 76 | (pattern (and (>= x:id lower-bound:expr) (<= x2:id upper-bound:expr)) 77 | #:when (free-identifier=? #'x #'x2)) 78 | 79 | (pattern (and (<= x:id upper-bound:expr) (<= lower-bound:expr x2:id)) 80 | #:when (free-identifier=? #'x #'x2)) 81 | 82 | (pattern (and (<= lower-bound:expr x:id) (<= x2:id upper-bound:expr)) 83 | #:when (free-identifier=? #'x #'x2)) 84 | 85 | (pattern (and (>= upper-bound:expr x:id) (>= x2:id lower-bound:expr)) 86 | #:when (free-identifier=? #'x #'x2)) 87 | 88 | (pattern (and (>= x:id lower-bound:expr) (>= upper-bound:expr x2:id)) 89 | #:when (free-identifier=? #'x #'x2)) 90 | 91 | (pattern (and (>= upper-bound:expr x:id) (<= lower-bound:expr x2:id)) 92 | #:when (free-identifier=? #'x #'x2)) 93 | 94 | (pattern (and (<= lower-bound:expr x:id) (>= upper-bound:expr x2:id)) 95 | #:when (free-identifier=? #'x #'x2))) 96 | 97 | 98 | (define-refactoring-rule two-exclusive-comparisons-to-triple-comparison 99 | #:description 100 | "Comparison functions like `<` accept multiple arguments, so this condition can be simplified." 101 | comparison:two-exclusive-comparisons 102 | (< comparison.lower-bound comparison.x comparison.upper-bound)) 103 | 104 | 105 | (define-refactoring-rule two-inclusive-comparisons-to-triple-comparison 106 | #:description 107 | "Comparison functions like `<=` accept multiple arguments, so this condition can be simplified." 108 | comparison:two-inclusive-comparisons 109 | (<= comparison.lower-bound comparison.x comparison.upper-bound)) 110 | 111 | 112 | (define-refactoring-suite comparison-shortcuts 113 | #:rules (comparison-of-difference-and-zero-to-direct-comparison 114 | two-exclusive-comparisons-to-triple-comparison 115 | two-inclusive-comparisons-to-triple-comparison)) 116 | -------------------------------------------------------------------------------- /default-recommendations/analyzers/variable-mutability-test.rkt: -------------------------------------------------------------------------------- 1 | #lang resyntax/test 2 | require: resyntax/default-recommendations/analyzers/variable-mutability variable-mutability-analyzer 3 | header: - #lang racket/base 4 | 5 | 6 | analysis-test: "unassigned module binding marked immutable" 7 | - (define a 1) 8 | @inspect - a 9 | @property variable-mutability 10 | @assert immutable 11 | 12 | 13 | analysis-test: "assigned module binding marked mutable" 14 | -------------------- 15 | (define a 1) 16 | (set! a 2) 17 | -------------------- 18 | @within - (define a 1) 19 | @inspect - a 20 | @property variable-mutability 21 | @assert mutable 22 | 23 | 24 | analysis-test: "unassigned phase 1 module binding marked immutable" 25 | -------------------- 26 | (require (for-syntax racket/base)) 27 | (begin-for-syntax 28 | (define a 1)) 29 | -------------------- 30 | @inspect - a 31 | @property variable-mutability 32 | @assert immutable 33 | 34 | 35 | analysis-test: "assigned phase 1 module binding marked mutable" 36 | -------------------- 37 | (require (for-syntax racket/base)) 38 | (begin-for-syntax 39 | (define a 1) 40 | (set! a 2)) 41 | -------------------- 42 | @within - (define a 1) 43 | @inspect - a 44 | @property variable-mutability 45 | @assert mutable 46 | 47 | 48 | analysis-test: "unassigned phase 2 module binding marked immutable" 49 | -------------------- 50 | (require (for-syntax racket/base) 51 | (for-meta 2 racket/base)) 52 | (begin-for-syntax 53 | (begin-for-syntax 54 | (define a 1))) 55 | -------------------- 56 | @inspect - a 57 | @property variable-mutability 58 | @assert immutable 59 | 60 | 61 | analysis-test: "assigned phase 2 module binding marked mutable" 62 | -------------------- 63 | (require (for-syntax racket/base) 64 | (for-meta 2 racket/base)) 65 | (begin-for-syntax 66 | (begin-for-syntax 67 | (define a 1) 68 | (set! a 2))) 69 | -------------------- 70 | @within - (define a 1) 71 | @inspect - a 72 | @property variable-mutability 73 | @assert mutable 74 | 75 | 76 | analysis-test: "function definition marked immutable" 77 | -------------------- 78 | (define (f) 79 | (void)) 80 | -------------------- 81 | @inspect - f 82 | @property variable-mutability 83 | @assert immutable 84 | 85 | 86 | analysis-test: "reassigned function definition marked mutable" 87 | -------------------- 88 | (define (f) 89 | (void)) 90 | (set! f (λ () (displayln "hi"))) 91 | -------------------- 92 | @within - (f) 93 | @inspect - f 94 | @property variable-mutability 95 | @assert mutable 96 | 97 | 98 | analysis-test: "function argument marked immutable" 99 | -------------------- 100 | (define (f x) 101 | (void)) 102 | -------------------- 103 | @inspect - x 104 | @property variable-mutability 105 | @assert immutable 106 | 107 | 108 | analysis-test: "reassigned function argument marked mutable" 109 | -------------------- 110 | (define (f x) 111 | (set! x 42) 112 | (void)) 113 | -------------------- 114 | @within - (f x) 115 | @inspect - x 116 | @property variable-mutability 117 | @assert mutable 118 | 119 | 120 | analysis-test: "macro definition marked immutable" 121 | -------------------- 122 | (require (for-syntax racket/base)) 123 | (define-syntax (m stx) 124 | #'(void)) 125 | -------------------- 126 | @inspect - m 127 | @property variable-mutability 128 | @assert immutable 129 | 130 | 131 | analysis-test: "macro definition's syntax argument marked immutable" 132 | -------------------- 133 | (require (for-syntax racket/base)) 134 | (define-syntax (m stx) 135 | #'(void)) 136 | -------------------- 137 | @inspect - stx 138 | @property variable-mutability 139 | @assert immutable 140 | 141 | 142 | analysis-test: "macro definition's syntax argument marked mutable when reassigned" 143 | -------------------- 144 | (require (for-syntax racket/base)) 145 | (define-syntax (m stx) 146 | (set! stx 42) 147 | #'(void)) 148 | -------------------- 149 | @inspect - stx 150 | @property variable-mutability 151 | @assert mutable 152 | 153 | 154 | analysis-test: "module binding marked mutable when reassigned via macro" 155 | -------------------- 156 | (require (for-syntax racket/base)) 157 | (define a 1) 158 | (define-syntax (m stx) 159 | #'(set! a 2)) 160 | (m) 161 | -------------------- 162 | @within - (define a 1) 163 | @inspect - a 164 | @property variable-mutability 165 | @assert mutable 166 | 167 | 168 | analysis-test: "module binding marked immutable when reassigning macro is unused" 169 | -------------------- 170 | (require (for-syntax racket/base)) 171 | (define a 1) 172 | (define-syntax (m stx) 173 | #'(set! a 2)) 174 | -------------------- 175 | @within - (define a 1) 176 | @inspect - a 177 | @property variable-mutability 178 | @assert immutable 179 | --------------------------------------------------------------------------------